Option Explicit
Sub vergleich()
Dim Wks1xAchse As Long, Wks2xAchse As Long, xAchse As Long, yAchse As Long
Dim Wks1yAchse As Long, Wks2yAchse As Long, Zeilen As Long, Spalten As Long
Dim QuellSuche, ZielSuche As Range
Wks1xAchse = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Column
Wks1yAchse = Worksheets(1).UsedRange.SpecialCells(xlCellTypeLastCell).Row
Wks2xAchse = Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Column
Wks2yAchse = Worksheets(2).UsedRange.SpecialCells(xlCellTypeLastCell).Row
If Wks1xAchse > Wks2xAchse Then
xAchse = Wks1xAchse
Else
xAchse = Wks2xAchse
End If
If Wks1yAchse > Wks2yAchse Then
yAchse = Wks1yAchse
Else
yAchse = Wks2yAchse
End If
ReDim excel1(yAchse, xAchse) As Variant
ReDim excel2(yAchse, xAchse) As Variant
Worksheets(2).Select
excel2() = Range(Cells(1, 1), Cells(yAchse, xAchse))
Worksheets(1).Select
excel1() = Range(Cells(1, 1), Cells(yAchse, xAchse))
For Zeilen = 2 To yAchse
Set QuellSuche = Worksheets(2).Range("A1:A" & yAchse).Find(excel1(Zeilen, 1), Lookat:=xlWhole)
Set ZielSuche = Worksheets(1).Range("A1:A" & yAchse).Find(excel2(Zeilen, 1), Lookat:=xlWhole)
If Not QuellSuche Is Nothing Then
For Spalten = 2 To xAchse
If excel1(Zeilen, Spalten) <> "" And excel1(Zeilen, Spalten) <> excel2(QuellSuche.Row, Spalten) Then
Worksheets(1).Cells(Zeilen, Spalten).Interior.ColorIndex = 6
End If
Next Spalten
Else
Worksheets(1).Range(Worksheets(1).Cells(Zeilen, 1), Worksheets(1).Cells(Zeilen, xAchse)).Interior.ColorIndex = 3
End If
If Not ZielSuche Is Nothing Then
For Spalten = 2 To xAchse
If excel2(Zeilen, Spalten) <> "" And excel2(Zeilen, Spalten) <> excel1(ZielSuche.Row, Spalten) Then
Worksheets(2).Cells(Zeilen, Spalten).Interior.ColorIndex = 6
End If
Next Spalten
Else
Worksheets(2).Range(Worksheets(2).Cells(Zeilen, 1), Worksheets(2).Cells(Zeilen, xAchse)).Interior.ColorIndex = 3
End If
Next Zeilen
End Sub
