AW: Sverweis mit mehreren Ergebnissen
24.03.2016 16:27:12
Steve
Hallo Sebastian,
von einem zweiten Blatt war nie die Rede, genauso wenig dass die Werte in Spalte A nicht mehr doppelt vorkommen sollen. Ein Verweis und Aussortieren sind gänzlich unterschiedliche Dinge. Ersteres sucht und findet nur.
Bitte solche Dinge nicht als selbstverständlich annehmen. Ihr macht es uns allen leichter wenn ihr gleich mit allen Anforderungen herausrückt, dann braucht nicht 10x umgedschrieben werden.
Das Ergebnis sah fast genauso aus wie bei dir im Bild, ich habe hier doppelte Werte wie deinen 14. März nicht doppelt anzeigen lassen, aber wenn du das wünschst umso einfacher. Nur das Ergebnis wurde in Spalte C geschrieben, ich zitiere mal "[...]und gib alle Ergebnisse in Spalte C aus."
lg Steve
Sub Test()
Dim oCol As Collection
Dim wks As Worksheet, wks2 As Worksheet
Dim rBereich As Range, rZelle As Range, rZ As Range
Dim sFirstAddress As String, sErgebnis As String
Dim i As Long, lZeile As Long
Set wks = Sheets("Tabelle1")
Set wks2 = Sheets("Tabelle2")
With wks
Set rBereich = .Range(.Range("A2"), .Cells(.Rows.Count, 1).End(xlUp))
End With
With wks2
lZeile = .Cells(.Rows.Count, 1).End(xlUp).Row
End With
Set oCol = New Collection
For Each rZelle In rBereich
On Error Resume Next
oCol.Add rZelle.Text, rZelle.Text
Debug.Print Err.Number
If Err.Number = 0 Then
On Error GoTo 0
Set rZ = rBereich.Find(rZelle, LookIn:=xlValues, LookAt:=xlWhole)
If Not rZ Is Nothing Then
sFirstAddress = rZ.Address
Do
If sErgebnis = "" Then
sErgebnis = rZ.Offset(0, 1)
Else
sErgebnis = sErgebnis & Chr(10) & rZ.Offset(0, 1)
End If
Set rZ = rBereich.FindNext(rZ)
Loop While Not rZ Is Nothing And rZ.Address sFirstAddress
End If
lZeile = lZeile + 1
wks2.Cells(lZeile, 1) = rZ
wks2.Cells(lZeile, 2) = sErgebnis
End If
On Error GoTo 0
sErgebnis = ""
Next rZelle
End Sub
