Zwei Arbeitsmappen miteinander vergleichen

103004

Möchten Sie 2 Arbeitsmappen miteinander vergleichen? Dann sollten Sie dieses Makro näher ansehen.
Verglichen werden die Anzahl der Tabellenblätter, die Anzahl der benutzen Zellen und die Zellinhalte.

Zuerst wird die Anzahl der Tabellenblätter unter die Lupe genommen. Bestehen hier bereits unterschiede wird das Makro mit der Meldung "Die Anzahl der Tabellenblätter ist unterschiedlich!" beendet. Ein weiterer Vergleich ist nicht mehr notwendig!

Ist die Anzahl der Tabellenblätter identisch, wird geprüft, ob die Anzahl der benutzten Zellen übereinstimmen. Als benutzte Zelle werden alle Zellen behandelt, die ein Zeichen enthalten. Auch Leerzeichen werden hierbei berücksichtigt. Stimmt die Anzahl der benutzen Zellen nicht überein, wird folgende Meldung ausgegeben:
"Die Anzahl der benutzen Zellen in Blatt x ist unterschiedlich!" und das Makro wird an dieser Stelle beendet.

Stimmt sowohl die Anzahl der Tabellenblätter als auch die Anzahl der benutzen Zellen beider Arbeitsmappen überein, werden jetzt die Zellinhalte verglichen. Unterscheiden sich die Zellinhalte, wird bei jedem Unterschied die Meldung "Unterschied wurde in Blatt x in Zelle y entdeckt!" ausgegeben. Möchten Sie nicht jeden Zell-Unterschied als Hinweis erhalten, so entfernen Sie einfach das Hochkomma' in der 4. Zeile von unten vor dem "Exit For". Sie erhalten dann nur die erste Differenz der beiden Arbeitsmappen mitgeteilt, was in den meisten Fällen auch genügen wird.


Sub Vergleich_Arbeitsmappen()
'Vergleich von Mappe X mit Mappe Y
Dim iWB As Integer, iWS As Integer
Dim rngObj As Range

'Vergleich Anzahl der Tabellenblätter
If Workbooks(1).Worksheets.Count <> Workbooks(2).Worksheets.Count Then
MsgBox "Die Anzahl der Tabellenblätter ist unterschiedlich!"
Exit Sub
End If

'Vergleich der benutzen Zellen
For iWS = 1 To Workbooks(1).Worksheets.Count
If Workbooks(1).Worksheets(iWS).UsedRange.Cells.Count <> Workbooks(2).Worksheets(iWS).UsedRange.Cells.Count Then
MsgBox "Die Anzahl der benutzen Zellen in Blatt " & iWS & " " & "ist unterschiedlich!"
Exit Sub
End If

'Vergleich der Zellinhalte
For Each rngObj In Workbooks(1).Worksheets(iWS).UsedRange
If rngObj.Value <> Workbooks(2).Worksheets(iWS).Range(rngObj.Address).Value Then
For iWB = 1 To 2
Workbooks(iWB).Worksheets(iWS).Activate
ActiveSheet.Range(rngObj.Address).Activate
Next
MsgBox "Unterschied wurde in Blatt " & iWS & " in Zelle " & rngObj.Address(False, False) & " entdeckt!"
'Exit For
End If
Next
Next

End Sub

Damit dieses Makro ordnungsgemäß funktionieren kann dürfen Sie beim Vergleich von zwei Arbeitsmappen nur die zu vergleichenden Mappen öffnen. Alle anderen Mappen schließen Sie bitte.