Anzeige
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Anzeige
Inhaltsverzeichnis

2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben

Forumthread: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben

2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 10:37:57
Andreas
Guten Morgen in die Runde,

leider reichen meine VBA-Kenntnisse nur so weit, dass ich schon sehr geeignete Lösungsansätze auf mein konkretes Beispiel ummünzen kann. Für das aktuelle Problem habe ich aber leider keine passende Vorlage gefunden und ich komme nicht weiter. Ich hoffe daher ganz sehr auf Eure Hilfe.

Vorab: eine Beispieldatei habe ich hochgeladen: https://www.herber.de/bbs/user/176539.xlsx

zum Problem:
Ich möchte zwei Tabellenblätter mit Firmen-Adressen vergleichen. Die Adressen sind Zeilenweise eingegeben. Jede Firma hat eine eindeutige Kennnummer die in Spalte A jeder Firmenadresse eindeutig zugewiesen ist.
Sollten sich bei den Adressen Änderungen ergeben haben, solle diese in einem dritten Tabellenblatt untereinander zeilenweise ausgegeben werden und die Zellen mit den Änderungen farblich (gelb) markiert werden.
Es können auch Firmen dazugekommen sein. Das würde man erkennen, wenn zusätzliche Firmenkennnummern dazugekommen sind. In dem Fall soll die Ausgabe im 3. Tabellenblatt so erfolgen erfolgen, dass alle Zellen farblich grün markiert sind.
Es können Firmen auch ganz verschwunden sein. Das würde man erkennen, wenn Firmenkennnummern in Tabelle 2 nicht auftauchen. In dem Fall soll die Ausgabe im 3. Tabellenblatt die Zeilen der Firma auch ausgegeben werden, allerdings sollen alle Zellen farblich rot markiert werden.

Nun hoffe ich ganz sehr, dass ich dass Problem gut beschreiben konnte. Noch mehr hoffe ich aber, dass es einen lieben Menschen gibt, der seine Zeit und Geduld mir schenkt und einen Lösungsansatz mir bereitstellen kann. Ich würde mich sehr, sehr freuen.

Ganz lieben Dank schon einmal an dieser Stelle fürs bis zum Ende lesen.

Viele Grüße, Andreas

Anzeige

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

Betreff
Datum
Anwender
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 11:51:42
Alwin Weisangler
Hallo Andreas,

anbei eine Möglichkeit alle differierenden/fehlenden Datensätze zu vergleichen.
Dies hatte ich mal für das CEF Forum gebaut.
- Starte das Userform und wähle Datei1 und Datei2 dieselbe zu vergleichende Datei.
- Wähle anschließend in den Comboboxen die zu vergleichenden Tabellenblätter aus.
- Starte den Vergleich.
Das Ergebnis des Vergleichs steht in Tabelle.
https://www.herber.de/bbs/user/176545.xlsm

Gruß Uwe
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 13:26:25
Andreas
Ich traue mich mal selbst eine theoretische Lösung zu formulieren, auf die Gefahr hin, dass die versierten VBA-Experten die Hände über den Kopf zusammenschlagen:

- Prüfe in Tabelle2 für Zeile 2, ob die Firmennnnr. in Spalte A auch in Tabelle 1 Spalte A enthalten ist.
Falls ja, dann prüfe, ob es unterschiede in den jeweiligen Zellen B2 bis J2 gibt. Falls ja, gebe die jeweilige Zeile der Tabelle2 in Tabelle3 aus und markiere die Zellen gelb mit Unterschieden
Falls nein, füge die Zeile 2 der Tabelle2 in Tabelle3 ein markiere die Zeile grün
- verfahre mit zeile 3 bis ende der Tabelle2 so weiter

- Prüfe in Tabelle1 für Spalte A von A2 bis A_Ende, ob die Firmennnnr. in Spalte A auch in Tabelle 2 Spalte A enthalten ist.
Falls nein, füge die Zeilen der Tabelle1 in Tabelle3 ein markiere die Zeilen rot.

Damit stehen dann die gelöschten Firmen am Ende der Vergleichstabelle 3, aber das wäre okay.

Ich hoffe ich habe mich jetzt nicht ganz blamiert.
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 16:02:11
Piet
Hallo

da liegen ja schon beachtliche Lösungen vor, mit modernen Codes, wo ich nicht mehr mitkomme! --> Hut ab vor eurem Wissen.
Mich hat interessiert ob ich mit meinem alten Excel 95/97 Wisssen einen Code anbieten kann, den sogar der Frager verstehen kann.

Hier mal meine Lösung mit drei Schleifen, weil ich mir das Sortieren ersparen wollte. Optisch evtl. übersichtlicher??
Dieser Code kann auch in Tabelle 1+2 die Änderungen mit markieren, sofern das erwünscht ist. Sonst Befehl löschen.

mfg Piet

Option Explicit

Dim AC As Range, lz1 As Long

Sub Dateien_vergleichen()
Dim Tb2 As Worksheet, s, z As Long
Dim Tb3 As Worksheet, rFind As Range
Set Tb3 = Worksheets("Aenderungen")
Set Tb2 = Worksheets(2): z = 2
Tb3.UsedRange.Offset(1, 0).Clear

With Worksheets(1)
lz1 = .Cells(Rows.Count, 1).End(xlUp).Row
'1. Schleife listet alle Änderungen auf
For Each AC In .Range("A2:A" & lz1)
Set rFind = Tb2.Columns(1).Find(What:=AC, After:=[a1], LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If Not rFind Is Nothing Then
'Vorprüfung ob Änderung vorliegt?
For s = 2 To 11
If AC.Cells(1, s) > rFind.Cells(1, s) Then Exit For
Next s
If s 11 Then 'Wenn Ja Daten kopieren
AC.Resize(1, 10).Copy Tb3.Cells(z, 1)
For s = 2 To 11 'Änderungen markieren
If AC.Value = "" And rFind.Cells(1, s) = "" Then
ElseIf AC.Cells(1, s) > rFind.Cells(1, s) Then
Tb3.Cells(z, s) = rFind.Cells(1, s)
Tb3.Cells(z, s).Interior.ColorIndex = 6
'** ggf auch in Tabelle 1+2 markieren
'** fall nicht erwünscht diese zwei Zeilen löschen
AC.Cells(1, s).Interior.ColorIndex = 6 '**
rFind.Cells(1, s).Interior.ColorIndex = 6 '**
End If
Next s
z = z + 1
End If
End If
Next AC

'2. Schleife listet alle Neuzugänge auf
For Each AC In .Range("A2:A" & lz1)
Set rFind = Tb2.Columns(1).Find(What:=AC, After:=[a1], LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If rFind Is Nothing Then
AC.Resize(1, 10).Copy Tb3.Cells(z, 1)
Tb3.Cells(z, 1).Resize(1, 10).Interior.ColorIndex = 43
z = z + 1
End If
Next AC

'3. Schleife listet alle gelöschten Daten auf
lz1 = Tb2.Cells(Rows.Count, 1).End(xlUp).Row
For Each AC In Tb2.Range("A2:A" & lz1)
Set rFind = .Columns(1).Find(What:=AC, After:=[a1], LookIn:=xlFormulas, _
LookAt:=xlWhole, SearchOrder:=xlByColumns, SearchDirection:=xlNext)
If rFind Is Nothing Then
AC.Resize(1, 10).Copy Tb3.Cells(z, 1)
Tb3.Cells(z, 1).Resize(1, 10).Interior.ColorIndex = 3
z = z + 1
End If
Next AC
End With
End Sub
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 16:13:28
Piet
Nachtrag

@Uwe -- alle Achtung vor deinen Codes, da habe ich immer Schwierigkeiten bei den vielen Set's durchzublicken. Habe ihn getestet!
Kleiner Wermutstropfen, mein Excel 2016 kennt keine -WorksheetFunktion.Concat-, da habe ich Laufzeitfehler!

@MCO -- auch dein Können bewundere ich, es war mir aber zu umständlich zuerst per xlDialog die Tabellen auswählen zu müssen.

So reizte es mich eine eigene Lösung vorzustellen. --> Simpel gestrickt, aber sicher effizient in der Anwendung.
Bei vielen Daten mag die alte For Next Version vielleicht zu langsam sein, aber bis 1000 Zeilen stört mich das wenig.
Jetzt bin ich gespannt was Andreas zu meiner Lösung sagt???

mfg Piet
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
03.04.2025 11:01:13
Alwin Weisangler
Hallo Piet,

der Fehler scheint nur so. Zusammengesetzte Teile in Strings gibt es einige.

Was für mich interessant wäre, an welcher Stelle es O2016 zu bunt wird.

Dieser Thread bring mich aber auf die Idee das Ganze mal weiter zu bauen und dem Ding eine Auswahl an Vergleichsmöglichkeiten (Vergleichsalgorithmen) zu verpassen.

Ich selbst löse so was gern mit Arrays. Das ist gut und Gerne um den Faktor 10 bis 20 schneller.
Klar bunte Zeilen gibt es dann nicht mehr.

Gruß Uwe
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
03.04.2025 13:49:45
Piet
Hallo Uwe

Danke für deine Antwort, die Idee mit dem Array finde ich schon Klasse. Ist erheblich schneller. Mein Tipp dazu:
Das Array macht die Zellen NICHT bunt, aber wenn du die Spalte A erfasst, und dann nur die Zellen mit den -Unterschieden-, ist die Array Version sicher auch sinnvoll. Man sieht sofort an welcher Stelle die Abweichungen sind. - Was meinst du dazu???

mfg Piet
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
03.04.2025 17:47:15
Andreas
Hallo Piet,

riesengroßen Dank an Dich!!! Der Code läuft perfekt.
Tatsächlich habe ich gestern und heute versucht die Logik von MCO's Code nachzuvollziehen und zu verstehen. Ich bin manchmal erst nach einiger längerer Recherche drauf gekommen, welche Befehle wie funktionieren und manchmal auch selbst daran gescheitert. Das führte leide auch dazu, dass ich immer noch nicht 100% die Funktion aus der Beispiel-Tabelle auf meine Original-Tabellen adaptieren könnte (es läuft zwar, aber ich muss hier und da Korrekturen an den Tabellen vornehmen. Schöner wäre es gewesen ich wäre in der Lage gewesen am Code entsprechende Änderungen vornehmen zu können). Ich will damit meinen riesengroßen Respekt (und ganz ehrlich auch ein wenig Neid) vor der Leistung aussprechen, wer so wahnsinnig gut in VBA schreiben kann. Danke nochmal an dieser Stelle an MCO!!! Und auch Uwe mit seinem 1. Lösungsansatz.

Lieber Piet, vielen, vielen Dank, dass du dein Wissen hier geteilt hast! Ich kann tatsächlich einfacher nachvollziehen, was der Code macht und entsprechende Anpassungen vornehmen. Mir hilft es ganz, ganz sehr und vielleicht auch noch anderen.
Ich bin so froh, dass alle hier die Fragen beantworten so uneigennützig uns Anfängern unter die Arme greifen. In allen Lösungsansätzen und Ideen steckt so viel Arbeit und Know-how drin.
Ich bin grade sehr glücklich!

Viele Liebe Grüße und nochmal Dank an Uwe, MCO und an Dich, Piet!
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
04.04.2025 00:38:10
Alwin Weisangler
Hallo Piet,

ich habe es eigentlich nicht so mit den bunten Sachen in den Zellen, aber sicher kann man das entsprechend mitgeben.

Du hattest das fehlende Verketten in älteren Office Versionen festgestellt. Da kann man eine Krücke benutzen.
Beispielhaft für Zeile 4:


ZeileVerkettet = Join(Application.Transpose(Application.Transpose(.Range("A4:J4"))), "")


Gruß Uwe
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 14:33:30
MCO
Hallo Andreas!

Ich hab dir code geschrieben, der folgende Dinge macht:

Prüfen ob a in b ist
ja: vergleichen der kompletten textfelder
--gleich: nix passiert
--ungleich: kopieren von b, hervorheben der Unterschiede zu a
nein: kopieren von a, alles rot markieren

Prüfen ob b in a ist
ja: nix passier
nein: neuer Datensatz, kopieren von b, hervorheben in Grün

Sortieren der Datensätze


Sollte so passen, auch wenns etwas länger gedauert hat...
Sub DAtenvergleich()


Dim ur_sh As Worksheet
Dim prüf_sh As Worksheet
Dim ziel_sh As Worksheet
Dim gef As Range
Dim FKenn As Range
Dim urRng As Range
Dim PrüfRng As Range

Set ur_sh = Sheets(1)
Set prüf_sh = Sheets(2)
Set ziel_sh = Sheets(3)

Set urRng = ur_sh.Range("A1").CurrentRegion.Offset(1, 0)
Set urRng = urRng.Resize(urRng.Rows.Count - 1, 1)

Set PrüfRng = prüf_sh.Range("A1").CurrentRegion.Offset(1, 0)
Set PrüfRng = PrüfRng.Resize(PrüfRng.Rows.Count - 1, 1)

For Each FKenn In urRng
Set gef = PrüfRng.Find(FKenn)

If Not gef Is Nothing Then 'gefunden, Vergleich
Ur_text = WorksheetFunction.Concat(ur_sh.Range("A" & FKenn.Row & ":J" & FKenn.Row))
Prf_text = WorksheetFunction.Concat(prüf_sh.Range("A" & gef.Row & ":J" & gef.Row))
'Debug.Print Ur_text:Debug.Print Prf_text
If Ur_text > Prf_text Then

zeil = ziel_sh.Range("A" & Rows.Count).End(xlUp).Row + 1

For sp = 1 To 10
With ziel_sh.Cells(zeil, sp)
.Value = prüf_sh.Cells(gef.Row, sp)
If prüf_sh.Cells(gef.Row, sp) > ur_sh.Cells(FKenn.Row, sp) Then
.Interior.ColorIndex = 6
End If
End With
Next sp
End If
Else 'nicht gefunden, gelöscht
zeil = ziel_sh.Range("A" & Rows.Count).End(xlUp).Row + 1
ur_sh.Range("A" & FKenn.Row & ":J" & FKenn.Row).Copy ziel_sh.Range("A" & zeil)
ziel_sh.Range("A" & zeil & ":J" & zeil).Interior.ColorIndex = 3
End If

Set gef = Nothing
Next FKenn

For Each FKenn In PrüfRng
Set gef = urRng.Find(FKenn)

If gef Is Nothing Then 'neuer Datensatz
zeil = ziel_sh.Range("A" & Rows.Count).End(xlUp).Row + 1
prüf_sh.Range("A" & FKenn.Row & ":J" & FKenn.Row).Copy ziel_sh.Range("A" & zeil)
ziel_sh.Range("A" & zeil & ":J" & zeil).Interior.ColorIndex = 4
End If
Next FKenn

With ziel_sh
Set sort_rng = .Range("A1").CurrentRegion
Set sort_rng2 = sort_rng.Offset(1, 0)
Set sort_rng2 = sort_rng2.Resize(sort_rng.Rows.Count - 1)

With .Sort
.SortFields.Clear
.SortFields.Add2 Key:=sort_rng2.Resize(sort_rng2.Rows.Count, 1), _
SortOn:=xlSortOnValues, _
Order:=xlAscending, _
DataOption:=xlSortTextAsNumbers

.SetRange sort_rng2
.Header = xlYes
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
End Sub


Gruß, MCO
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 15:02:52
Andreas
Lieber MCO,

das ist der Hammer!!! Ich bin Dir so dankbar!
Es klappt so perfekt.
Ich habe es auch gleich mal in meiner Original-Tabelle probiert und konnte mit nur wenigen Anpassungen hier genau das ausgeben lassen, was ich erwartet habe.
Wenn ich mir den Quellcode anschaue, weiß ich, dass ich niemals nie allein drauf gekommen wäre. Ich werde jetzt versuchen, die einzelnen Befehle von Dir mal nachzuvollziehen um zu lernen.

Sehr, sehr cool.

Danke, danke, danke!

und viele Grüße

Andreas
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 13:07:52
Andreas
Hallo Uwe,

ganz herzlichen Dank, dass du mir deinen entwickelten VBA-Lösungsansatz zur Verfügung gestellt hast. Ich empfinde das nicht selbstverständlich. Sehr, sehr cool.
Bei erstem ersten Test konnte ich glaube ich erkennen, dass die Logik mit dazukommenden und wegfallenden Firmen Probleme hat. Wahrscheinlich erfolgt ein Vergleich streng zeilenweise. Wenn aber eine Firma dazukommt oder wegfällt, erkennt er alle darauffolgenden Eintragungen als Unterschiede an, oder?
Das stellt bei meiner Wunschlösung tatsächlich ein Problem dar. Zum Glück habe ich die eindeutigen Firmenkennnummern, über die die daran anschließenden Kennwerte miteinander verglichen werden müssen.

Ich würde meine Fragestellung erstmal noch als offen gekennzeichnet lassen. Dir danke ich aber ganz, ganz sehr. Falls ich keinen weitere Hilfestellung erhalten sollte, kann ich somit versuchen (ich fürchte zwar das ich da scheitere) dein Ansatz zu adaptieren.

Vielen Dank und beste Grüße

Andreas
Anzeige
AW: 2 Tabellen vergleichen, Unterschiede zeilenw. ausgeben
02.04.2025 13:22:18
Alwin Weisangler
Hallo Andreas,

ja dem ist so.
Um deinen Wunsch zu erfüllen braucht es eine weitere Schleife in dieser Schleife.

Gruß Uwe

Forumthreads zu verwandten Themen

Anzeige