Hallo,
ich möchte zwei Tabellen (Tabelle1 und Tabelle2) in einer Arbeitsmappe (ab Zeile 2) miteinander vergleichen und die Unterschiede durch farbliche Markierung der jeweiligen Zelle in Tabelle1 sichtbar machen.
Ich versuche, die angedachte Logik einigermaßen präzise zu beschreiben und hoffe, dass es nicht zu langatmig ist:
Die Ausgangsdateien sind formatierungsmäßig identisch und besitzen 40 Spalten mit verschiedenen Zellformaten (numerisch, alphanumerisch, Datum), besitzen jedoch eine u. U. unterschiedliche Anzahl an Zeilen (insgesamt ca. 2000 Zeilen). In Spalte 3 steht ein Schlüssel (6-stellige Nummer), der für die Suche herangezogen werden soll. Alle weiteren Spalten (ab Spalte 4 bis 40) sind Zusatzinformationen, die nun verglichen werden sollen (Spalte 1 und 2 sind nicht relevant). Es sollen nun alle Zeilen von Tabelle1 abgearbeitet werden und dabei jeder Spalteninhalt mit der gleichen Spalte von Tabelle2 verglichen werden, sofern der Satz mit der gleichen Nummer gefunden werden kann. Unterscheiden sich beide Zellen in irgendeiner Weise, soll die Zelle von Tabelle1 gelb markiert und mit einem "x" in Spalte 41 versehen werden. Die aus Tabelle2 verglichene Zelle erhält in Spalte 41 ein "e" für erledigt. Wird die Zeile in Tabelle2 jedoch nicht gefunden, soll die ganze Zeile aus Tabelle1 grün markiert werden und ebenfalls ein "x" gesetzt werden.
Nun kann es sein, dass in Tabelle2 Sätze enthalten sind, die in Tabelle1 fehlen bzw. bei diesem Durchlauf nicht angesprochen wurden (also in Tabelle2 noch kein "e" in Spalte 41 haben). Diese Zeilen sind dann zu kopieren und an Tabelle1 anzuhängen. Alle angehängten Sätze sollen rot markiert werden. In Tabelle2 wird wieder ein "e" gesetzt, in Tabelle1 ein "x".
Auf der Suche nach einer Lösung bin ich auf nachfolgendes Programm gestoßen, welches vielleicht verwendet werden könnte. Leider ist mir nicht ganz klar, wie sich der zeilenweise Vergleich zusätzlich in einen zellbezogenen Vergleich erweitern ließe.
Wer hätte eine Idee, wie wie man das angehen könnte?
Vielen Dank im voraus für eure Hilfe.
Grüße, Constantin
Option Explicit
Option Base 1
Sub tt()
Dim wsA As Worksheet, wsB As Worksheet, gefunden As Boolean, zeiA As Long, zeiB As Long
Dim SatzA() As String, SatzB() As String, n As Long, nn As Long
Set wsA = Worksheets("Tabelle1")
Set wsB = Worksheets("Tabelle2")
With wsA
.UsedRange.Interior.ColorIndex = xlNone
ReDim SatzA(.Range("A65536").End(xlUp).Row)
For zeiA = 1 To .Range("A65536").End(xlUp).Row
SatzA(zeiA) = Zusammen(.Cells(zeiA, 1))
Next zeiA
.UsedRange.Interior.ColorIndex = xlNone
ReDim SatzB(wsB.Range("A65536").End(xlUp).Row)
For zeiB = 1 To wsB.Range("A65536").End(xlUp).Row
SatzB(zeiB) = Zusammen(wsB.Cells(zeiB, 1))
Next zeiB
For n = 1 To UBound(SatzA)
gefunden = False
For nn = 1 To UBound(SatzB)
If SatzA(n) = SatzB(nn) Then
gefunden = True
Exit For
End If
Next nn
If gefunden = False Then .Range(.Cells(n, 1), .Cells(n, 6)).Interior.ColorIndex = 6 ' _
gelb
Next n
For n = 1 To UBound(SatzB)
gefunden = False
For nn = 1 To UBound(SatzA)
If SatzB(n) = SatzA(nn) Then
gefunden = True
Exit For
End If
Next nn
If gefunden = False Then
wsB.Range(wsB.Cells(n, 1), wsB.Cells(n, 6)).Copy Destination:=.Cells(zeiA, 1)
.Range(.Cells(zeiA, 1), .Cells(zeiA, 6)).Interior.ColorIndex = 10 'grün
zeiA = zeiA + 1
End If
Next n
End With
End Sub
Function Zusammen(Zelle As Range) As String
Dim s As Integer, Spalten As Integer
Spalten = 6 'Spaltenanzahl
For s = 0 To Spalten - 1
Zusammen = Zusammen & Zelle.Offset(0, s)
Next s
End Function
' geschrieben von Reinhard