Tabellenvergleich
31.10.2005 10:18:06
Wolfgang
ich habe das folgende Makro.
Es soll erweitert werden wenn kein treffer da ist soll in Tabelle1 Spalte C der Text eingetragen werden "Nicht in Tabelle2 vorhanden"
Sub ORG_Suchen_und_einfügen()
Dim wksT1 As Worksheet, wksT2 As Worksheet, _
rng As Range, rFind As Range, z As Range
On Error GoTo errorhandler
Application.ScreenUpdating = False
Set wksT1 = Sheets("Tabelle1") 'Tabellenname anpassen!
Set wksT2 = Sheets("Tabelle2") 'Tabellenname anpassen!
For Each rng In wksT1.Range("B1:B" & wksT1.Cells(65536, 2).End(xlUp).Row)
If rng <> "" Then
Set rFind = wksT2.Range("A:A").Find(rng)
If Not rFind Is Nothing Then
wksT1.Cells(rng.Row, 3).Value = wksT2.Cells(rFind.Row, 12).Value
wksT1.Cells(rng.Row, 4).Value = wksT2.Cells(rFind.Row, 13).Value
'Nicht in Tabelle2 vorhanden
If rFind Is Nothing Then
wksT1.Cells(rng.Row, 3).Value = "Nicht in Tabelle2 vorhanden"
End If
End If
End If
Next rng
errorhandler:
Application.ScreenUpdating = True
End Sub