Tabelle1:
Tabelle2:
Code: (ausführlich)
Option Explicit
Sub Main()
Dim rngTabelle1 As Excel.Range
Dim rngTabelle2 As Excel.Range
Dim c As Excel.Range
Dim vRet As Variant
Set rngTabelle1 = Tabelle1.Range("A2:A5")
Set rngTabelle2 = Tabelle2.Range("A2:A5")
For Each c In rngTabelle2 '*** für jede Zelle im Bereich Tabelle2 A2 bis A5
vRet = Application.Match(c.Value, rngTabelle1, 0) '*** prüfe, ob sich der Wert in Tabelle1 A2 bis A5 findet und merke Dir die realtive Position in einer Variablen
'*** entweder, der Wert wird gefunden oder wird nicht gefunden
If IsError(vRet) Then
'*** wenn nicht gefunden, dann bekommt die Variable einen Fehlerwert zugewiesen
Else
'*** wenn gefunden, dann bekommt die Variable die relative Position zugewiesen
c.Offset(0, 2).Value = rngTabelle1.Cells(vRet, 2).Value
c.Offset(0, 3).Value = rngTabelle1.Cells(vRet, 2).Offset(0, 1).Value
End If
Next c
End Sub
Ergebnis:
Hinweis:
Es gibt zwei Test2 in der Ergebnistabelle, aber nur ein Test2 in der Suchtabelle.
Dieses Beispiel liefert Dir stets den ersten Treffer in der Suchtabelle (!)
Hinweis2:
Der IF-Else-Block kann verkürzt werden, sollte die Auswertung auf Fehler irrelevant sein:
If Not IsError(vRet) Then
c.Offset(0, 2).Value = rngTabelle1.Cells(vRet, 2).Value
c.Offset(0, 3).Value = rngTabelle1.Cells(vRet, 2).Offset(0, 1).Value
End If
|