Sheet-Vergleich mit Identifier

Hallo,
ich hatte hier schon mal mein Problem beschrieben (kann leider nicht mehr drauf antworten), es wurde auch gelöst - leider nun doch nciht gut genug, laut Cheffchen :(
https://www.herber.de/forum/archiv/1188to1192/t1188624.htm#1188624
Und zwar hab ich das Problem derzeit, dass wenn eine neue Zeile in Tab2 vorhanden ist, der zeilenweise Vergleich NICHT mehr geht. Da er die neue Zeile findet, und danach ALLES falsch ist, da die Zeilen eins nach unten verrutscht sind.
Es soll nun so sein:
Diese beiden Sheets sollen am besten nach einem Identifier durchsucht werden.
- In Tab1 gibt es zu jeder Aktivität eine ID, die wir aus unserem Planungstool herausholen (alte Version Vorwoche)
- die ID (neue Version diese Woche) soll in Tab2 gesucht werden.
- wenn die ID in Tab2 gefunden wurde, soll die komplette Zeile in Tab1 mit der kompletten Zeile Tab2 verglichen werden
- wenn irgendwo zwischen den beiden Zeilen eine Abweichung auftritt (egal welche Zelle), soll diese Zelle farbig markiert werden
- tritt keine Abweichung auf - passiert nichts
- ist eine völlig NEUE Zeile in Tab2 hinzugekommen, soll diese komplett farbig markiert werden (gelb)

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Benutzer

Hi Daniel,
hier habe ich die alte Variante etwas nach deinen (besser: deines Chefs) neuen Wünschen
umgebaut:


Option Explicit
Sub meinVergleich4()
Dim lngR As Long, lngC As Long, zz As Long, cc As Long
Dim arrA, arrB, arrID, varF, arrOK() As Boolean, lngF As Long
Dim blnDif As Boolean
Const lngID As Long = 2   ' ID in Spalte B (=2) - anpassen
With Worksheets("Tabelle1")
lngR = .Cells(.Rows.Count, 1).End(xlUp).Row
lngC = .Cells(1, .Columns.Count).End(xlToLeft).Column
arrA = .Range(.Cells(3, 1), .Cells(lngR, lngC))
End With
With Worksheets("Tabelle2")
zz = .Cells(.Rows.Count, 1).End(xlUp).Row
If zz  arrB(lngF, cc) Then
.Cells(lngF + 2, cc).Font.ColorIndex = 3
' oder auch
.Cells(lngF + 2, cc).Interior.ColorIndex = 6
blnDif = True
End If
Next cc
If blnDif Then .Cells(lngF + 2, lngC + 2) = "x"
End If
Next zz
For zz = 1 To UBound(arrOK)
If Not arrOK(zz) Then
With .Rows(zz + 2)
.Font.ColorIndex = 3
' oder auch
.Interior.ColorIndex = 6
End With
.Cells(zz + 2, lngC + 2) = ">>"
End If
Next zz
End With
End Sub

Und hier eine Spielmappe: https://www.herber.de/bbs/user/73703.xls
Rückmeldung wäre nett! - Grüße von Erich aus Kamp-Lintfort

Beliebteste Forumthreads (12 Monate)

2 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

2
Beiträge zum Forumthread

Beiträge zu diesem Forumthread