Private Sub Vergleich_Arbeitsmappen()
Dim intWB As Integer, intWS As Integer
Dim objDic As Object
Dim regObj As Range
Dim i As Long
Dim x As Long
Dim objDic1 As Object
Dim objDic2 As Object
Dim key As Variant
Set objDic1 = CreateObject("scripting.dictionary")
Set objDic2 = CreateObject("scripting.dictionary")
If Workbooks(sDateiName1).Worksheets.Count <> _
Workbooks(sDateiName2).Worksheets.Count Then
MsgBox "Die Anzahl der Tabellenblätter ist unterschiedlich!"
End If
For intWS = 1 To Workbooks(sDateiName1).Worksheets.Count
If Workbooks(sDateiName1).Worksheets(intWS).UsedRange.Cells.Count <> _
Workbooks(sDateiName2).Worksheets(intWS).UsedRange.Cells.Count Then
MsgBox "Die Anzahl der benutzen Zellen in Blatt " & intWS & " " & "ist unterschiedlich!"
End If
Workbooks(sDateiName1).Worksheets(intWS).Activate
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
Workbooks(sDateiName1).Worksheets(intWS).Activate
If Not objDic1.exists(Cells(i, 1).Value) Then
objDic1.Add Cells(i, 1).Value, i
End If
Next
Workbooks(sDateiName2).Worksheets(1).Activate
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If Not objDic2.exists(Cells(x, 1).Value) Then
objDic2.Add Cells(x, 1).Value, x
End If
Next
Debug.Print "Datei 1"
Debug.Print ""
For Each key In objDic1.Keys
Debug.Print key, objDic1(key)
Next key
Debug.Print ""
Debug.Print "Datei 2"
Debug.Print ""
For Each key In objDic2.Keys
Debug.Print key, objDic2(key)
Next key
Workbooks(sDateiName2).Worksheets(1).Activate
For i = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If objDic1.exists(ActiveSheet.Cells(i, 1).Value) Then
Cells(i, 1).Interior.ColorIndex = 4
Else
Cells(i, 1).Interior.ColorIndex = 3
End If
Next
Workbooks(sDateiName1).Worksheets(1).Activate
For x = 1 To Cells(Rows.Count, 1).End(xlUp).Row
If objDic2.exists(ActiveSheet.Cells(x, 1).Value) Then
Cells(x, 1).Interior.ColorIndex = 4
Else
Cells(x, 1).Interior.ColorIndex = 3
End If
Next
Next
End Sub