weis jemand wie man über VBA doppelte Ausdrücke über zwei Blätter hinweg vergleicht und dann die Zellen rot einfärbt?
Irgendwie weis ich garnicht wie ich das machen soll.
https://www.herber.de/bbs/user/131389.xlsx
=B11&"|"&C11&"|"&D11&"|"&E11&"|"&F11&"|"&G11
=ISTZAHL(VERGLEICH(H11;Tabelle1!H:H;0))
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
Sub doppelteFinden()
Dim b As Long
Dim TB
Dim z As Long
Dim id As String
Dim dic
Dim WF As Object
Set WF = WorksheetFunction
Const ZeileAb As Long = 11
Set dic = CreateObject("scripting.dictionary")
TB = Array("Tabelle1", "Tabelle2")
'--- Doppelte finden
For b = 0 To UBound(TB)
With Sheets(TB(b))
For z = ZeileAb To .Cells(.Rows.Count, 2).End(xlUp).Row
id = Join(WF.Transpose(WF.Transpose(.Cells(z, 2).Resize(, 6))), "|")
If dic(id)
der Code ist so geschrieben, dass du damit nicht nur 2 sondern auch mehrere Tabellenblätter auf Duplikate in allen Blättern überprüfen kannst, einfach indem du den Blattnamen im Array TB hinzufügst.