vor einiger Zeit wurde mir hier folgender Code zur Verfügung gestellt (wofür ich dem Mitarbeiter auch sehr dankbar bin, hat mir sehr geholfen):
Sub compareSheets()
Dim objWB As Workbook
Dim vntSrc1 As Variant, vntSrc2 As Variant
Dim vntInBoth() As Variant, vntInFirstOnly() As Variant, vntInSecondOnly() As Variant
Dim vntIdentisch() As Variant, vntInFirst() As Variant, vntInSecond() As Variant
Dim vntZeileFirst() As Variant, vntZeileSecond() As Variant
Dim vntDataFirst As Variant, vntDataSecond As Variant
Dim bolIdentisch As Boolean, Spalte As Long
Dim lngIndex As Long, lngCBoth As Long, lngCFirst As Long, lngCSecond As Long
Dim vntRet As Variant, blnWasOpen As Boolean
Dim strFile1 As String, strFile2 As String
strFile1 = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm", Title:="Bitte erste Datei wählen")
If strFile1 = CStr(False) Then Exit Sub
strFile2 = Application.GetOpenFilename("Excel Dateien (*.xls; *.xlsx; *.xlsm)," & _
"*.xls; *.xlsx; *.xlsm", Title:="Bitte zweite Datei wählen")
If strFile2 = CStr(False) Then Exit Sub
On Error GoTo Errexit
With Application
.ScreenUpdating = False
.EnableEvents = False
End With
For Each objWB In Workbooks
If objWB.FullName = strFile1 Then
blnWasOpen = True
Exit For
End If
Next
If objWB Is Nothing Then Set objWB = Workbooks.Open(strFile1)
With objWB.Sheets("Tabelle1")
vntSrc1 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
vntDataFirst = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
.Cells(1, .Columns.Count).End(xlToLeft).Column))
End With
If Not blnWasOpen Then objWB.Close False
Set objWB = Nothing
blnWasOpen = False
For Each objWB In Workbooks
If objWB.FullName = strFile2 Then
blnWasOpen = True
Exit For
End If
Next
If objWB Is Nothing Then Set objWB = Workbooks.Open(strFile2)
With objWB.Sheets("Tabelle1")
vntSrc2 = .Range("A2:A" & .Cells(.Rows.Count, 1).End(xlUp).Row)
vntDataSecond = .Range(.Cells(2, 1), .Cells(.Cells(.Rows.Count, 1).End(xlUp).Row, _
.Cells(1, .Columns.Count).End(xlToLeft).Column))
End With
If Not blnWasOpen Then objWB.Close False
ReDim vntInBoth(0)
vntInBoth(0) = "In beiden Dateien"
lngCBoth = 1
ReDim vntIdentisch(0)
vntIdentisch(0) = "Identisch"
ReDim vntInFirst(0)
vntInFirst(0) = "Zeile " & strFile1
ReDim vntInSecond(0)
vntInSecond(0) = "Zeile " & strFile2
ReDim vntInFirstOnly(0)
vntInFirstOnly(0) = "Nur in Datei " & strFile1
lngCFirst = 1
ReDim vntZeileFirst(0)
vntZeileFirst(0) = "Zeile"
ReDim vntInSecondOnly(0)
vntInSecondOnly(0) = "Nur in Datei " & strFile2
lngCSecond = 1
ReDim vntZeileSecond(0)
vntZeileSecond(0) = "Zeile"
For lngIndex = 1 To UBound(vntSrc1, 1)
vntRet = Application.Match(vntSrc1(lngIndex, 1), vntSrc2, 0)
If IsNumeric(vntRet) Then
ReDim Preserve vntInBoth(lngCBoth)
vntInBoth(lngCBoth) = vntSrc1(lngIndex, 1)
bolIdentisch = True
'Vergleich der Werte in den Spalten der Zeilen
For Spalte = LBound(vntDataFirst, 2) To UBound(vntDataFirst, 2)
If vntDataFirst(lngIndex, Spalte) vntDataSecond(vntRet, Spalte) Then
bolIdentisch = False
Exit For
End If
Next
ReDim Preserve vntIdentisch(lngCBoth)
vntIdentisch(lngCBoth) = bolIdentisch
ReDim Preserve vntInFirst(lngCBoth)
vntInFirst(lngCBoth) = lngIndex + 1
ReDim Preserve vntInSecond(lngCBoth)
vntInSecond(lngCBoth) = vntRet + 1
lngCBoth = lngCBoth + 1
Else
ReDim Preserve vntInFirstOnly(lngCFirst)
vntInFirstOnly(lngCFirst) = vntSrc1(lngIndex, 1)
ReDim Preserve vntZeileFirst(lngCFirst)
vntZeileFirst(lngCFirst) = lngIndex + 1
lngCFirst = lngCFirst + 1
End If
Next
For lngIndex = 1 To UBound(vntSrc2, 1)
vntRet = Application.Match(vntSrc2(lngIndex, 1), vntSrc1, 0)
If Not IsNumeric(vntRet) Then
ReDim Preserve vntInSecondOnly(lngCSecond)
vntInSecondOnly(lngCSecond) = vntSrc2(lngIndex, 1)
ReDim Preserve vntZeileSecond(lngCSecond)
vntZeileSecond(lngCSecond) = lngIndex + 1
lngCSecond = lngCSecond + 1
End If
Next
ThisWorkbook.Worksheets.Add after:=ActiveSheet
With ActiveSheet
.Name = "Vergleich_" & Format(Now, "yyyymmdd-hhMMss")
.Range("A1").Resize(UBound(vntInBoth) + 1, 1) = Application.Transpose(vntInBoth)
.Range("B1").Resize(UBound(vntIdentisch) + 1, 1) = Application.Transpose(vntIdentisch)
.Range("C1").Resize(UBound(vntInFirst) + 1, 1) = Application.Transpose(vntInFirst)
.Range("D1").Resize(UBound(vntInSecond) + 1, 1) = Application.Transpose(vntInSecond)
.Range("E1").Resize(UBound(vntInFirstOnly) + 1, 1) = Application.Transpose(vntInFirstOnly)
.Range("F1").Resize(UBound(vntZeileFirst) + 1, 1) = Application.Transpose(vntZeileFirst)
.Range("G1").Resize(UBound(vntInSecondOnly) + 1, 1) = Application.Transpose(vntInSecondOnly) _
_
.Range("H1").Resize(UBound(vntZeileSecond) + 1, 1) = Application.Transpose(vntZeileSecond)
.Rows(1).Font.Bold = True
.Columns.AutoFit
End With
Errexit:
With Application
.ScreenUpdating = True
.EnableEvents = True
End With
Set objWB = Nothing
End Sub
Der Code leistet folgendes: Zwei Dateien (z.Bsp. Test1 und Test2) werden auf identische Daten verglichen. Ausgabe ist folgende: Daten, die nur in Datei Test1 und solche, die nur in Datei Test2 und solche Daten, die in beiden Dateien vorkommen. Zusätzlich wird jeweils die Zeile angegeben. Dieser Code funktioniert auch hervorragend. Nun mein Problem: Der Code funktioniert nur, wenn in beiden Dateien keine doppelten Daten vorhanden sind.
Gibt es eine Möglichkeit den Quellcode so zu ändern, daß er einen Vergleich zwischen beiden Dateien erstellt, wenn in einer der beiden oder aber in beiden doppelte Daten vorkommen?
Liebe Grüße
Stefan