Tabellen vergleichen
11.09.2006 21:03:39
Sebastian
hoffe es kann mir jemand weiterhelfen. Habe folgendes Makro über die Recherche gefunden und auf meine Bedürfnisse angepasst. Leider fehlt mir noch der letzte Schritt in dem Makro. Also sobald ich Differenzen in den Tabellen gefunden habe, will ich (jetzt: nur entsprechende Zelle) die komplette Zeile in die neue Tabelle kopieren. Hoffe es kann mir jemand weiterhelfen wäre ech super. Danke. Also hier der Code:
Sub vergleicheTabellen()
Dim arr As Variant
Dim wks1 As Worksheet, wks2 As Worksheet, wks3 As Worksheet
Dim n As Long, lastRow1 As Long, lastRow2 As Long, lastRow3 As Long
Dim rng As Range
Set wks1 = Sheets("Finance")
'Tabelle1 - anpassen
Set wks2 = Sheets("Calc")
'Tabelle2 - anpassen
Set wks3 = Sheets("New")
'Tabelle3
lastRow1 = IIf(wks1.Range("B65536") <> "", 65536, _
wks1.Range("B65536").End(xlUp).Row)
'ermitteln der letzten belegten Zelle in Tabelle1
lastRow2 = IIf(wks2.Range("B65536") <> "", 65536, _
wks2.Range("B65536").End(xlUp).Row)
'ermitteln der letzten belegten Zelle in Tabelle2
lastRow3 = IIf(wks3.Range("B65536") <> "", 65536, _
wks3.Range("B65536").End(xlUp).Row)
'ermitteln der letzten belegten Zelle in Tabelle3
arr = wks1.Range("F21:F" & lastRow2)
'Daten aus Tabelle2 an Array übergeben
For n = 1 To UBound(arr, 1)
Set rng = wks2.Range("F:F").Find(arr(n, 1))
'Daten aus Tab2 in Tab1 suchen und
'wenn nicht gefundenin Tab1 eintragen
If rng Is Nothing Then
lastRow3 = lastRow3 + 1
wks3.Cells(lastRow3, 2) = arr(n, 1)
End If
Next
End Sub
Grüße Sebastian
PS: Weiss jemand zufällig wie man zwei Tabellen vergleicht und dabei jede einzelnen Zelle mit der entsprechenden Zelle der anderen Tabelle vergleicht. Die TAbellen sind vom Aufbau her komplett identisch