Vergleich 2 Tabellen Makro

Forumthread: Vergleich 2 Tabellen Makro

20.07.2016 08:54:24

Bertl

Hallo Leute,
erstmal vorneweg; habe leider mit Programmierung nicht soo viel Erfahrung, vor ca. einem Jahr habe ich aber in einem Uni Kurs C# ein bisschen kennengelernt.
Habe hier schon etwas mitgelesen, aber leider noch niemanden mit genau der gleichen Fragestellung gefunden:
Ich muss 2 Tabellen vergleichen und bei gefundenen Unterschieden die ganze Zeile in ein 3tes Tabellenblatt kopieren. Denke das lässt sich am besten per Makro lösen.
Habe etwas weiter unten eine ähnliche Fragestellung gefunden (von Dauth: https://www.herber.de/forum/messages/1505034.html), allerdings muss in meinen Tabellen jede Spalte einer Zeile mit den dazugehörigen Spalten der dazugehörigen Zeile verglichen werden, sprich die Unterschiede können in jeder Spalte auftreten und sollten auch dementsprechend untersucht werden.
Im Detail sieht das so aus;
In der Arbeitsmappe befinden sich 3 Tabellenblätter, "Input_alt", "Input_neu" und "Output". "Input_alt" und "Input_neu" sollen miteinander verglichen werden und bei jedem Unterschied (Wert in irgendeiner Spalte anders, Zeile nur in "Input_neu", Zeile nur in "Input_alt", usw.) die gesamte Zeile in das 3te Tabellen "Output" kopiert werden.
Jede Zeile hat eine einzigartige ID, d.h. neue und fehlende IDs können sofort kopiert werden. leider ändert sich die ID aber nicht wenn sich nur ein Wert ändert.
Im Beitrag von Dauth hat Christian schon einen verständlichen Code gepostet, der funktioniert bei mir recht gut, allerdings werden dort immer nur die Werte in einer bestimmten Spalte verglichen.
Ich denke bei mir müsste man eine 2te Laufvariable für die Spalten hinzufügen, die für jede betrachtete Zeile durchläuft und das Programm erst dann in die nächste Zeile springt.
Habe das schon selbst versucht, leider komme ich da nicht so recht auf einen grünen Zweig. Im Anhang findet ihr eine Beispieldatei, in diesem Fall sollte das Output Zeilen 1, 3, 4, 11, 12 und 18 umfassen.
Ich danke euch schonmal für die Hilfe!

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Das File

20.07.2016 08:55:27

Bertl
AW: Vergleich 2 Tabellen Makro

20.07.2016 10:21:37

Bertl
AW: Vergleich 2 Tabellen Makro

20.07.2016 12:52:16

Jürgen
AW: Vergleich 2 Tabellen Makro

20.07.2016 14:37:09

Bertl
AW: Vergleich 2 Tabellen Makro

21.07.2016 12:35:07

Jürgen
AW: Vergleich 2 Tabellen Makro

21.07.2016 13:19:42

Bertl

AW: Vergleich 2 Tabellen Makro

20.07.2016 10:21:37

Bertl

Habe zur Zeit folgenden Code: (Danke an Christian!)

Sub Abgleich()
Dim maxRN As Integer
Dim maxRA As Integer
Dim wsN As Worksheet
Dim wsA As Worksheet
Dim wsZ As Worksheet
Dim i, iii As Long
Set wsN = ThisWorkbook.Worksheets("Input_neu")
Set wsA = ThisWorkbook.Worksheets("Input_alt")
Set wsZ = ThisWorkbook.Worksheets("Output")
maxRN = wsN.Cells(wsN.Rows.Count, 1).End(xlUp).Row
maxRA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
Call Weg(wsZ)
For i = 2 To maxRN
For iii = 1 To 15
If IstDa(wsN.Cells(i, iii), wsA, iii) = False Then
wsN.Cells(i, iii).EntireRow.Copy Destination:=wsZ.Cells((wsZ.Rows.Count), iii).  _
_
End(xlUp).Offset(1, 0).EntireRow
End If
Next iii
Next i
For i = 2 To maxRA
For iii = 1 To 15
If IstDa(wsA.Cells(i, iii), wsN, iii) = False Then
wsA.Cells(i, iii).EntireRow.Copy Destination:=wsZ.Cells((wsZ.Rows.Count), iii).  _
_
End(xlUp).Offset(1, 0).EntireRow
End If
Next iii
Next i
End Sub
Private Function IstDa(ByRef ArtID As String, ByRef ws As Worksheet, iii) As Boolean
Dim i As Long
For i = 2 To ws.Cells(ws.Rows.Count, iii).End(xlUp).Row
If ArtID = ws.Cells(i, iii) Then
IstDa = True
Exit Function
End If
Next
IstDa = False
End Function
Private Sub Weg(ws As Worksheet)
ws.Range("A2:" & Cells(Rows.Count - 1, Columns.Count).Address).Clear
End Sub

Funktioniert so weit nicht soo schelcht, allerdings werden viele Zeilen öfter ausgegeben, in meinem Beispiel-File wird z.B. Zeile 1 6 mal ins Output kopiert, Zeile 12 2 mal, Zeile 11 3 mal usw.
Größtes Problem; es wird nicht erkannt wenn sich ein Wert von einer Zeile in eine andere verschoben hat (im Bsp. Schulter_2 und Schulter_3 vertauscht).
Ich Danke euch!

AW: Vergleich 2 Tabellen Makro

20.07.2016 12:52:16

Jürgen

Hallo Bertl,
die Sache mit den mehrfachen Werten m Outputsheet kommt daher, dass wenn mehrere Spalten einer Zeile geändert wurden nicht überprüft wird, ob die ID im Outputsheet vorhanden ist.
Ich denke das dieses Makro nicht besonders schnell in der Laufzeit ist.
Außerdem kann es nicht vorkommen, dass in einer der Tabellen eine Zeile dazwischen eingefügt wird?
Hier eine ungeprüfte Lösungsvorschlag.
Einfach mal testen.
Wenn er klappt, bitte kommentieren.

Sub Test()
Dim oDictIDneu As Object, oDictIDalt As Object, oDictIDout As Object
Dim maxRN As Integer
Dim maxRA As Integer
Dim wsN As Worksheet
Dim wsA As Worksheet
Dim wsZ As Worksheet
Dim i, iii As Long
Dim key
Set oDictIDneu = CreateObject("Scripting.dictionary")
Set oDictIDalt = CreateObject("Scripting.dictionary")
Set oDictIDout = CreateObject("Scripting.dictionary")
oDictIDout.RemoveAll
oDictIDalt.RemoveAll
oDictIDneu.RemoveAll
Set wsN = ThisWorkbook.Worksheets("Input_neu")
Set wsA = ThisWorkbook.Worksheets("Input_alt")
Set wsZ = ThisWorkbook.Worksheets("Output")
maxRN = wsN.Cells(wsN.Rows.Count, 1).End(xlUp).Row
maxRA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
Call Weg(wsZ)
For i = 2 To maxRN
If Not oDictIDneu.exists(wsN.Cells(i, 1).Value) Then
oDictIDneu.Add wsN.Cells(i, 1), i                   'Hier wird die ID mit der  _
Zeilennummer eingetragen.
Else
x = MsgBox(wsN.Cells(i, 1) & "ist doppelt in der Tabelle NEu enthalten", vbOKOnly, " _
Doppelte Werte")
End If
Next i
For i = 2 To maxRA
If Not oDictIDalt.exists(wsA.Cells(i, 1).Value) Then
oDictIDalt.Add wsA.Cells(i, 1), i                   'Hier wird die ID mit der  _
Zeilennummer eingetragen.
Else
x = MsgBox(wsN.Cells(i, 1) & "ist doppelt in der Tabelle NEu enthalten", vbOKOnly, " _
Doppelte Werte")
End If
Next i
'Alle nicht enthaltenen IDs der alten Tabelle werden übertragen.
For Each key In oDictIDalt
If Not oDictIDneu(key).exists And Not oDictIDout(key).exists Then
wsA.Cells(oDictIDalt(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ.Rows.Count) _
, 1).End(xlUp).Offset(1, 0).EntireRow
oDictIDout.Add key, wsZ.Rows.Count
End If
Next key
'Alle nicht enthaltenen IDs der neuen Tabelle werden übertragen.
For Each key In oDictIDneu
If Not oDictIDalt(key).exists And Not oDictIDout(key).exists Then
wsA.Cells(oDictIDneu(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ.Rows.Count) _
, 1).End(xlUp).Offset(1, 0).EntireRow
oDictIDout.Add key, wsZ.Rows.Count
Else
'Die Werte werden 1x unabhängig von Verschiebungen in den Zeilen abgeglichen.
For iii = 2 To 15
If wsN.Cells(oDictIDneu(key), iii).Value  wsA.Cells(oDictIDalt(key), 111). _
Value Then
'hier werden entsprechend deines bisherigen Makros beide entsprechungen übertrage. ggf. eine  _
Zeile löschen.
wsA.Cells(oDictIDalt(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ. _
Rows.Count), 1).End(xlUp).Offset(1, 0).EntireRow
wsN.Cells(oDictIDneu(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ. _
Rows.Count), 1).End(xlUp).Offset(1, 0).EntireRow
Exit For                'Nach einmaligem Kopieren wird nicht weitergesucht.  _
-->Keine doppelten Zeilen! ;-)
End If
Next iii
End If
Next key
End Sub
Private Sub Weg(ws As Worksheet)
ws.Range("A2:" & Cells(Rows.Count - 1, Columns.Count).Address).Clear
End Sub

Gruß
Jürgen

AW: Vergleich 2 Tabellen Makro

20.07.2016 14:37:09

Bertl

Hallo Jürgen,
erstmal vielen, vielen Dank für deine Mühe!
Leider bekomme ich beim Testen den Laufzeitfehler "424"; "Objekt erforderlich" und der Debugger verweist mich auf folgende Zeile:

If Not oDictIDneu(key).exists And Not oDictIDout(key).exists Then

Kann es sein dass der Ausdruck "key" da das Problem verursacht? (weil der ja in jedem Dict. vorhanden ist oder?)
Habe mit solchen Dictitionaries leider noch nie gearbeitet...
Und du hast natürlich recht, es kann genauso passieren dass mitten drinnen eine neue Zeile dazu kommt, allerdings nicht in der Arbeitsmappe in der verglichen wird.
Inwiefern könnte das ein Problem sein? Das Skript definiert bei jedem Durchlauf den zu betrachtenden Bereich eh wieder neu soweit ich das richtig verstehe?
Sorry für die möglicherweise dummen Fragen.
LG.

AW: Vergleich 2 Tabellen Makro

21.07.2016 12:35:07

Jürgen

Hallo Bertl,
also so eine kleine Pausenaufgabe ohne Test ist halt doch nichts. :-)
Ich habe noch 4 Fehler behoben und getestet!

Sub Test()
Dim oDictIDneu As Object, oDictIDalt As Object, oDictIDout As Object
Dim maxRN As Integer
Dim maxRA As Integer
Dim wsN As Worksheet
Dim wsA As Worksheet
Dim wsZ As Worksheet
Dim i, iii As Long
Dim key
Set oDictIDneu = CreateObject("Scripting.dictionary")
Set oDictIDalt = CreateObject("Scripting.dictionary")
Set oDictIDout = CreateObject("Scripting.dictionary")
oDictIDout.RemoveAll
oDictIDalt.RemoveAll
oDictIDneu.RemoveAll
Set wsN = ThisWorkbook.Worksheets("Input_neu")
Set wsA = ThisWorkbook.Worksheets("Input_alt")
Set wsZ = ThisWorkbook.Worksheets("Output")
maxRN = wsN.Cells(wsN.Rows.Count, 1).End(xlUp).Row
maxRA = wsA.Cells(wsA.Rows.Count, 1).End(xlUp).Row
Call Weg(wsZ)
For i = 2 To maxRN
If Not oDictIDneu.exists(wsN.Cells(i, 1).Value) Then
oDictIDneu.Add wsN.Cells(i, 1).Value, i                   'Hier wird die ID mit der  _
_
Zeilennummer eingetragen.
Else
x = MsgBox(wsN.Cells(i, 1) & "ist doppelt in der Tabelle Neu enthalten", vbOKOnly, " _
Doppelte Werte")
End If
Next i
For i = 2 To maxRA
If Not oDictIDalt.exists(wsA.Cells(i, 1).Value) Then
oDictIDalt.Add wsA.Cells(i, 1).Value, i                   'Hier wird die ID mit der  _
_
Zeilennummer eingetragen.
Else
x = MsgBox(wsN.Cells(i, 1) & "ist doppelt in der Tabelle NEu enthalten", vbOKOnly, " _
Doppelte Werte")
End If
Next i
'Alle nicht enthaltenen IDs der alten Tabelle werden übertragen.
For Each key In oDictIDalt
If Not oDictIDneu.exists(key) And Not oDictIDout.exists(key) Then
wsA.Cells(oDictIDalt(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ.Rows.Count) _
, 1).End(xlUp).Offset(1, 0).EntireRow
oDictIDout.Add key, wsZ.Rows.Count
End If
Next key
'Alle nicht enthaltenen IDs der neuen Tabelle werden übertragen.
For Each key In oDictIDneu
If Not oDictIDalt.exists(key) And Not oDictIDout.exists(key) Then
wsN.Cells(oDictIDneu(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ.Rows.Count) _
, 1).End(xlUp).Offset(1, 0).EntireRow
oDictIDout.Add key, wsZ.Rows.Count
ElseIf Not oDictIDout.exists(key) Then
'Die Werte werden 1x unabhängig von Verschiebungen in den Zeilen abgeglichen.
For iii = 2 To 15
If wsN.Cells(oDictIDneu(key), iii).Value  wsA.Cells(oDictIDalt(key), iii). _
Value Then
'hier werden entsprechend deines bisherigen Makros beide entsprechungen übertrage. ggf. eine  _
Zeile löschen.
wsA.Cells(oDictIDalt(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ. _
Rows.Count), 1).End(xlUp).Offset(1, 0).EntireRow
wsN.Cells(oDictIDneu(key), 1).EntireRow.Copy Destination:=wsZ.Cells((wsZ. _
Rows.Count), 1).End(xlUp).Offset(1, 0).EntireRow
Exit For                'Nach einmaligem Kopieren wird nicht weitergesucht.  _
-->Keine doppelten Zeilen! ;-)
End If
Next iii
End If
Next key
End Sub
Private Sub Weg(ws As Worksheet)
ws.Range("A2:" & Cells(Rows.Count - 1, Columns.Count).Address).Clear
End Sub

Die Fehlermeldung deines letzten Beitrags war leider klar ersichtlich! Ich habe die Abfrage ja oben im Makro schon richtig verwendet.

statt:
If Not oDictIDneu(key).exists And Not oDictIDout(key).exists Then
ist richtiger:
If Not oDictIDneu.exists (key) And Not oDictIDout.exists(key) Then

Wenn ich dann noch das Value und nicht die ganze Zelle in das Dictionary aufnehme, geht dass noch besser.

statt:
oDictIDalt.Add wsA.Cells(i, 1), i
besser:
oDictIDalt.Add wsA.Cells(i, 1).value, i

Dann habe ich noch einen Elseif eingefügt,
damit wird es noch einmal schneller.

ElseIf Not oDictIDout.exists(key) Then

Zum Schluss hatte ich noch wsa mit wsn verwechselt.
Inwiefern könnte das ein Problem sein? Das Skript definiert bei jedem Durchlauf den zu betrachtenden Bereich eh wieder neu soweit ich das richtig verstehe?

Das ist richtig. Wie erkennt diese Funktion jedoch, dass die einmalige HauptID in Zeile 15 ist, wenn du (vorausgesetzt deine HauptID ist in Spalte A) die Spalte A nicht nach der ID durchsuchst?
Mein Vorschlag arbeite mit den Dictionaries genau diese HauptID ab. (Sollte diese in einer anderen Spalte als A sein, musst du bei diesen Befehlen

oDictIDalt.Add wsA.Cells(i, 1).Value, i

die 1 ändern.
Wurde eine Zeile einmal kopiert, werden die Einzelspalten gar nicht mehr durchsucht.
--> Nicht alle Zeilen einer Spalte nach dem Wert durchsuchen, sondern "nur" die Spalten einer definierten Zeile, die noch nicht kopiert wurde durchsuchen.
Es war jetzt etwas ausführlich, aber ich hoffe du hast mit diesem Makro viel Spaß.
Gruß
Jürgen

AW: Vergleich 2 Tabellen Makro

21.07.2016 13:19:42

Bertl

Hallo Jürgen,
Du bist mein Held!
Vielen, vielen Dank!
Habe in der Zwischenzeit den Fehler in der vorher erwähnten Code-Zeile auch entdeckt, ich denke es ist primär noch daran gescheitert dass als Key ins Dictionary noch nicht die Value hinzugefügt wurde, das war definitiv der Knackpunkt für mich.
Habe dein Skript auch schon in einem praxisrelevanten Arbeitsblatt (doch etwas mehr Zeilen und Spalten zu durchsuchen^^) getestet und es funktioniert wunderbar.
Vielen Dank auch für die ausführlichen Erklärungen dazu, das macht das Ganze wirklich sehr interessant und verständlich :)
Hoffe ich hab dir nicht zu viel Zeit gekostet,
LG.

Beliebteste Forumthreads (12 Monate)

Forumthread: Vergleich 2 Tabellen Makro

6 Beiträge zum Forumthread Beiträge zu diesem Forumthread

Forumthreads zu verwandten Themen

VBA Beispiele zu diesem und ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

6
Beiträge zum Forumthread

Beiträge zu diesem Forumthread