Inhalte von zwei Tabellen vergleichen
In diesem Beispiel zeige ich, wie man in zwei Tabellen nach doppelten Daten/Datensätzen suchen
kann. Das ist sicher eine Aufgabe, die bei größeren Tabellen öfter anfallen kann.
Das erste Beispiel zeigt ein Makro, das in einer Spalte mehrfach vorkommende Werte findet und in
der nächsten Spalte kennzeichnet.
Beispiel 1:
Sub doppelte_Daten_suchen()
' vergleicht Tabelle 2 mit Tabelle 1 und schreibt Werte
' aus Tabelle 2, die in Tabelle 1 nicht vorkommen in Tabelle 3
Dim verg1(500), verg2(500), dopp(500) As Integer, num(500) ' Variablen dimensionieren
Dim y As Integer, z As Integer, r As Integer, s As Integer ' Variablen deklarieren
Dim zz As Integer, u As Integer ' Variablen deklarieren
' Tabelle 1 einlesen
Worksheets("Tabelle1").Activate ' Tabelle 1 aktivieren
y = 2 ' Startwert für Schleifenzähler (hier Zeile 2)
Do While Cells(y, 1) <> "" ' Bedingung für Schleife (Laufe solange Zelle gefüllt ist)
verg1(y) = Cells(y, 2) ' Inhalte in Variable einlesen
y = y + 1 ' Schleifenzähler um 1 erhöhen
Loop ' Wendepunkt für Schleife
' Tabelle 2 einlesen
Worksheets("Tabelle2").Activate ' Tabelle 2 aktivieren
z = 2 ' Startwert für Schleifenzähler (hier Zeile 2)
Do While Cells(z, 1) <> "" ' Bedingung für Schleife (Laufe solange Zelle gefüllt ist)
num(z) = Cells(z, 1) ' Inhalte in Variable einlesen
verg2(z) = Cells(z, 2) ' Inhalte in Variable einlesen
z = z + 1 ' Schleifenzähler um 1 erhöhen
Loop ' Wendepunkt für Schleife
' Inhalte vergleichen
For r = 2 To y - 1 ' Start äußere Schleife
For s = 2 To z - 1 ' Start innere Schleife
If verg1(r) = verg2(s) Then ' wenn Werte gleich dann ...
dopp(s) = 1 ' ... Variable auf 1 setzen
Cells(s, 3) = "gleich" ' ... Wert in Tabelle markieren
End If ' Ende der Bedingung
Next s ' Wendepunkt für innere Schleife
Next r ' Wendepunkt für äußere Schleife
' In Tabelle 3 schreiben
Worksheets("Tabelle2").Activate ' Tabelle 3 aktivieren
zz = 1 ' Startwert für Schleifenzähler (hier Zeile 2)
For u = 1 To z - 1 ' Start für Schleife
If dopp(u) = 0 Then ' wenn Variable = 0 dann ...
Cells(zz, 1) = num(u) ' ... 1. Wert in Zelle schreiben
Cells(zz, 2) = verg2(u) ' ... 2. Wert in Zelle schreiben
zz = zz + 1 ' ... Schleifenzähler um 1 erhöhen
End If ' Ende der Bedingung
Next u ' Wendepunkt für Schleife
End Sub
Will man in den Vergleich, die Inhalte mehrerer Spalten einbeziehen, müssen die Zeilen 'verg1(y)
= Cells(y, 2)' und 'verg1(z)
= Cells(z, 2)' nach folgenden Muster verändert werden:
verg1(y) = Cells(y, 2) & Cells(y, 3) & Cells(y, 4) & ...
verg2(z) = Cells(z, 2) & Cells(z, 3) & Cells(z, 4) & ...
Dabei ist es auch möglich, eine unterschiedliche Anordnung der Spalten in den zu vergleichenden
Tabellen(blättern) zu berücksichtigen. Das könnte dann so aussehen:
verg1(y) = Cells(y, 2) & Cells(y, 3) & Cells(y, 4) & ...
verg2(z) = Cells(z, 5) & Cells(z, 1) & Cells(z, 3) & ...
Beispiel 2:
In diesem Beispiel werden zwei Tabellen mit einander verglichen und alle Inhalte, die nur
in einer der Tabellen vorkommen, werden in eine dritte Tabelle geschrieben.
Option Explicit
Private Sub Tabellenvergleich()
' vergleicht zwei Tabellen und schreibt Werte, die nicht
' in beiden Tabellen vorkommen, in eine dritte Tabelle
' excel@klaus-dieter-2000.de
' http://www.klaus-dieter-2000.de (Excel und VBA für Einsteiger)
' letzte Änderung 29.05.2005
' Variablen deklarieren
Dim verg1(5000) As String
Dim verg2(5000) As String
Dim merk1(5000) As String
Dim merk2(5000) As String
Dim z As Integer
Dim y As Integer
Dim r As Integer
Dim s As Integer
Dim t, tt As Integer
Dim v, vv As Integer
' Werte aus Tabelle 1 einlesen
z = 2 ' Schleifenzähler auf Startwert (Zeile 1)
Do While Worksheets("tab1").Cells(z, 1) <> "" ' Start der Schleife zum Einlesen der Werte
verg1(z) = Worksheets("tab1").Cells(z, 1) ' Vergleichswert einlesen
z = z + 1 ' Schleifenzähler um 1 erhöhen
Loop ' Wendepunkt für Schleife
' Werte aus Tabelle 2 einlesen
y = 2 ' Wie oben
Do While Worksheets("tab2").Cells(y, 1) <> "" ' "
verg2(y) = Worksheets("tab2").Cells(y, 1) ' "
y = y + 1 ' "
Loop ' "
' Werte vergleichen
For r = 1 To z - 1 ' Start "äußere" For To Next Schleife
For s = 1 To y - 1 ' Start "innere" For To Next Schleife
' Gleiche Werte markieren
If verg1(r) = verg2(s) Then merk1(r) = "ja" ' Wenn Vergleichswerte gleich, Merker setzen
If verg2(s) = verg1(r) Then merk2(s) = "ja" ' Wenn Vergleichswerte gleich, Merker setzen
Next s ' Wendepunkt "innere" For To Next Schleife
Next r ' Wendepunkt "äußere" For To Next Schleife
' Ungleiche Werte aus Tabelle 1 ausgeben
For t = 1 To r ' Start For To Next Schleife
If merk1(t) <> "ja" Then ' Wenn Merker = "ja" dann
tt = tt + 1 ' Zeilenzähler um 1 erhöhen
Worksheets("Prüfung").Cells _
(tt, 1) = verg1(t) ' Vergleichswert in Tabelle schreiben
End If ' Ende Wenn-Bedingung
Next t ' Wendepunkt For To Next Schleife
' Ungleiche Werte aus Tabelle 2 ausgeben
For v = 1 To s ' wie oben
If merk2(v) <> "ja" Then ' "
vv = vv + 1 ' "
Worksheets("Prüfung").Cells _
(vv + t, 1) = verg2(v) ' "
End If ' "
Next v ' "
End Sub
Code eingefügt mit: Excel Code Jeanie
Die beiden Tabellen werden "über Kreuz" verglichen, so ist sicher gestellt, daß
alle Werte gefunden werden, die nur in einer der beiden Tabellen erscheinen. Mit dem "Merker" habe ich
gearbeitet, weil eine Suche nach ungleichen Werten, in jeder Zeile einen Treffer erzielen würde.
Ich habe eine Beipieltabelle mit den Quellkodes in den
Downloadbereich gestellt.