AW: doppelte Ausdrücke über 2 Blätter markieren
12.08.2019 11:34:45
fcs
Hallo Jens,
der Weg über Hilfsspalten und Formeln + bedingte Formatierung geht eigentlich schneller.
1. Hilfsspalte (hier Spalte H) in beiden Blättern: Formel in Zeile 11 generiert die eindeutige ID aus den 6 Spalten
=B11&"|"&C11&"|"&D11&"|"&E11&"|"&F11&"|"&G11
2. Hilfsspalte sucht die ID in der jeweils anderen Tabelle.
=ISTZAHL(VERGLEICH(H11;Tabelle1!H:H;0))
Die Formeln in den beiden Hilfsspalten nach unten kopieren
Wenn die ID in der anderen Tabelle vorhanden ist, dann liefert die Formel in der 2. Hilfsspalte als Ergebnis WAHR.
Dieses Ergebnis kann man in einer bedingten Formatierung verarbeiten.
Makro-Lösung kann wie folgt aussehen.
LG
Franz
Sub TabVergleich()
Dim wks1 As Worksheet, wks2 As Worksheet
Dim zei_1 As Long, Zei_2 As Long, Zeile As Long, Spalte As Long
Dim arrID1() As String, arrID2() As String
Const sSep As String = "|"
Set wks1 = ActiveWorkbook.Worksheets("Tabelle1")
Set wks2 = ActiveWorkbook.Worksheets("Tabelle2")
'IDs in Tabelle 1 zusammenfügen und in Array speichern
With wks1
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
ReDim arrID1(zei_1 To Zei_2)
For Zeile = zei_1 To Zei_2
For Spalte = 2 To 7
arrID1(Zeile) = arrID1(Zeile) & sSep & .Cells(Zeile, Spalte).Text
Next
Next
End With
'IDs in Tabelle 2 zusammenfügen und in Array speichern
With wks2
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
ReDim arrID2(zei_1 To Zei_2)
For Zeile = zei_1 To Zei_2
For Spalte = 2 To 7
arrID2(Zeile) = arrID2(Zeile) & sSep & .Cells(Zeile, Spalte).Text
Next
Next
End With
'IDs aus Tabelle 1 in IDs der Tabelle 2 suchen und Zeilen markieren wenn in 2 vorhanden
With wks1
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
For Zeile = zei_1 To Zei_2
If IsNumeric(Application.Match(arrID1(Zeile), arrID2, 0)) Then
.Range(.Cells(Zeile, 2), .Cells(Zeile, 6)).Interior.ColorIndex = 3
End If
Next
End With
'IDs aus Tabelle 2 in IDs der Tabelle 1 suchen und Zeilen markieren wenn in 1 vorhanden
With wks2
zei_1 = 11
Zei_2 = Cells(.Rows.Count, 2).End(xlUp).Row
For Zeile = zei_1 To Zei_2
If IsNumeric(Application.Match(arrID2(Zeile), arrID1, 0)) Then
.Range(.Cells(Zeile, 2), .Cells(Zeile, 6)).Interior.ColorIndex = 3
End If
Next
End With
End Sub