2 Tabellenblätter vergleichen

Artanan · 2014-09-29T15:10:58+00:00

Hallo ich habe eine excel-Datei, in der 2 identisch aufgebaute Tabellen auf 2 Blättern vorkommen. Ich möchte gerne diese beiden Tabellen vergleichen und unterschiede in der 2. Tabelle rot markieren. das problem dabei: es können in der 2. Tabelle neue zeilen hinzugekommen sein. diese müsste dann komplett rot markiert werden. Zur veranschauung habe ich mal ein beispiel hochgeladen. https://www.herber.de/bbs/user/92878.xlsx Hätte hier jmd eine gute idee?

Hallo Artanan,
dein letzter post kam zu spät. Hier eine Lösung für die Kombination b, c und d.

Sub Finden()
Dim myString As Variant
Dim myColor As Integer
Dim a As Integer
Dim i As Long
Dim findRow As Long
Dim lastRow As Long
Dim lastCol As String
Dim findRng As Range
Dim wksSource As Worksheet
Dim wksZiel As Worksheet
Set wksSource = Worksheets("Extrakt1")
Set wksZiel = Worksheets("Extrakt2")
myColor = 3
lastRow = wksZiel.Cells(Rows.Count, 2).End(xlUp).Row
lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1)
With wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row)
.FormulaR1C1 = "=RC[-254]&RC[-253]&RC[-252]"
.Value = .Value
End With
For i = 3 To lastRow
myString = wksZiel.Range("B" & i).Value & wksZiel.Range("C" & i).Value & wksZiel.Range("D" & _
i).Value
Set findRng = wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row).Find(What:= _
myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not findRng Is Nothing Then
findRow = findRng.Row
For a = 1 To ActiveSheet.Cells(2, Columns.Count).End(xlToLeft).Column
If wksZiel.Cells(i, a).Value  wksSource.Cells(findRow, a).Value Then
wksZiel.Cells(i, a).Interior.ColorIndex = myColor
End If
Next a
Else
wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor
End If
Next i
wksSource.Range("IV3:IV" & Cells(Rows.Count, 1).End(xlUp).Row).ClearContents
Set wksZiel = Nothing
Set wksSource = Nothing
Set findRng = Nothing
End Sub

Gruß
Klaus

Hallo Artanan,
hmm, so ganz genau weiß ich nicht, was Du meinst.
Probier mal

Sub Finden()
Dim myString As Variant
Dim myColor As Integer
Dim a As Integer
Dim i As Long
Dim findRow As Long
Dim lastRow As Long
Dim lastCol As String
Dim findRng As Range
Dim wksSource As Worksheet
Dim wksZiel As Worksheet
Set wksSource = Worksheets("Extrakt1")
Set wksZiel = Worksheets("Extrakt2")
myColor = 3
lastRow = wksZiel.Cells(Rows.Count, 1).End(xlUp).Row
lastCol = Mid(Cells(2, Columns.Count).End(xlToLeft).Address, 2, 1)
For i = 2 To lastRow
myString = wksZiel.Range("B" & i).Value
If myString = "" Then GoTo LEER
Set findRng = wksSource.Range("B2:B" & Cells(Rows.Count, 2).End(xlUp).Row).Find(What:= _
myString, Lookat:=xlWhole, LookIn:=xlValues, MatchCase:=True)
If Not findRng Is Nothing Then
findRow = findRng.Row
For a = 1 To wksZiel.Cells(2, Columns.Count).End(xlToLeft).Column
If wksZiel.Cells(i, a).Value  wksSource.Cells(findRow, a).Value Then
wksZiel.Cells(i, a).Interior.ColorIndex = myColor
End If
Next a
Else
wksZiel.Range("A" & i & ":" & lastCol & i).Interior.ColorIndex = myColor
End If
LEER:
Next i
Set wksZiel = Nothing
Set wksSource = Nothing
Set findRng = Nothing
End Sub

Wenn es immer noch kneift, dann ändere mal die Daten so, dass der Fehler auftritt
und poste die neue Datei. Mit den vorhandenen Daten läuft es bei mir fehlerfrei.
Und was willst Du im Code angepasst haben?
Ich habe doch Deine Tabellenblatt-Namen übernommen ...
Gruß
Klaus

Forumthread: 2 Tabellenblätter vergleichen

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

Beliebteste Forumthreads (12 Monate)

2 Tabellenblätter vergleichen

Forumthread: 2 Tabellenblätter vergleichen

12 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

12
Beiträge zum Forumthread

Beiträge zu diesem Forumthread