Anzeige
Archiv - Navigation
1296to1300
Aktuelles Verzeichnis
Verzeichnis Index
Übersicht Verzeichnisse
Vorheriger Thread
Rückwärts Blättern
Nächster Thread
Vorwärts blättern
Anzeige
HERBERS
Excel-Forum (Archiv)
20+ Jahre Excel-Kompetenz: Von Anwendern, für Anwender
Inhaltsverzeichnis

Tab vergleichen, farblich hervorheben

Tab vergleichen, farblich hervorheben
15.02.2013 18:19:21
Heike
Hallo,
in einer Datei möchte ich 2 Tabellen vergleichen (alt & neu), die Unterschiede in "neu" farblich hervorheben. Hab hier ein tolles Makro gefunden, was auch super funktioniert. Dieses Makro vergleicht Zeile für Zeile, ich aber möchte, dass das Makro nach der eindeutigen Personalnummer guckt und dann vergleicht.
Denn die Tabelle kann in der Praxis nicht sortiert werden. Wäre schön, wenn jemand eine Lösung für mich hätte, die Infos sind aber auch im Tabellenblatt "Aufgabe" noch einmal hinterlegt.
Wäre schön, wenn jemand eine Lösung für mich hätte.
https://www.herber.de/bbs/user/83932.xlsm
Vielen Dank schon einmal im voraus
Gruß
Heike

7
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tab vergleichen, farblich hervorheben
16.02.2013 12:12:19
fcs
Hallo Heike,
nachfolgend ein Makro, dass einen solchen Tabellenvergleich mit Farbmakierungen macht.
In der Tabelle "neu" werden zusätzlich in der Spalte neben den Daten die geänderten Zeilen markiert.
Achtung:
Deine hochgeladene Datei enthält hochsensible personenbezogenen Daten. Wenn das echte Daten sind, dann solltest du Hans W. Herber bitten diesen Thread oder zumindest die verlinkte Datei zu löschen.
Du kannst dir großen Ärger einhandeln, wenn diese Daten die Runde machen.
Stichwort: Verstoß gegen das Datenschutzgesetz
Gruß
Franz
Sub VergleichenTabellen()
Dim arrAlt, arrNeu, arrIdAlt, arrIdNeu
Dim wksAlt As Worksheet
Dim wksNeu As Worksheet
Dim Spalte As Long, Spalte_L As Long
Dim ZeilenAlt As Long, ZeilenNeu As Long, varId As Variant, varZeile As Variant
Set wksAlt = Sheets("alt")
'Tabelle1 - anpassen
Set wksNeu = Sheets("neu")
'Tabelle2 - anpassen, in dieser Tabelle wird gekennzeichnet!
With wksAlt
Spalte_L = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Nummer der letzten zu  _
vergleichende Spalte
ZeilenAlt = .Cells(.Rows.Count, 1).End(xlUp).Row
arrAlt = .Range(.Cells(1, 1), .Cells(ZeilenAlt, Spalte_L))
arrIdAlt = .Range(.Cells(1, 1), .Cells(ZeilenAlt, 1))
End With
With wksNeu
ZeilenNeu = .Cells(.Rows.Count, 1).End(xlUp).Row
arrNeu = .Range(.Cells(1, 1), .Cells(ZeilenNeu, Spalte_L))
arrIdNeu = .Range(.Cells(1, 1), .Cells(ZeilenNeu, 1))
'Zellfarben im Datenbereich löschen
.Range(.Cells(2, 1), .Cells(ZeilenNeu, Spalte_L)).Interior.ColorIndex = xlColorIndexNone
'Daten in markierungsspalte löschen
.Range(.Columns(Spalte_L + 1), .Columns(Spalte_L + 1)).ClearContents
End With
'Änderungen in neu markieren und nicht mehr vorhandenen in alt
For ZeilenAlt = 2 To ZeilenAlt
varId = arrIdAlt(ZeilenAlt, 1)
'Id im neuen Blatt suchen
varZeile = Application.Match(varId, arrIdNeu, 0)
If IsError(varZeile) Then
With wksAlt
.Range(.Cells(ZeilenAlt, 1), .Cells(ZeilenAlt, Spalte_L)).Interior.ColorIndex = 6
End With
Else
With wksNeu
For Spalte = 1 To Spalte_L
If arrAlt(ZeilenAlt, Spalte)  arrNeu(ZeilenAlt, Spalte) Then
wksNeu.Cells(varZeile, Spalte).Interior.ColorIndex = 6
wksNeu.Cells(varZeile, Spalte_L + 1).Value = "geändert" 'Zeile markieren
End If
Next Spalte
End With
End If
Next ZeilenAlt
'Neue Zeilen in Neumarkieren
For ZeilenNeu = 2 To ZeilenNeu
varId = arrIdNeu(ZeilenNeu, 1)
'Id im alten Blatt suchen
varZeile = Application.Match(varId, arrIdAlt, 0)
If IsError(varZeile) Then
With wksNeu
.Range(.Cells(ZeilenNeu, 1), .Cells(ZeilenNeu, Spalte_L)).Interior.ColorIndex = 6
wksNeu.Cells(ZeilenNeu, Spalte_L + 1).Value = "neu" 'Zeile markieren
End With
End If
Next ZeilenNeu
'Arrays zurücksetzen
Erase arrAlt, arrNeu, arrIdAlt, arrIdNeu
End Sub

Anzeige
AW: Tab vergleichen, farblich hervorheben
16.02.2013 18:46:17
Heike
Hallo Frank,
vielen Dank für deine Info, aber die Tabelle hatte ich mal in einem Seminar bekommen, um daraus Pivot zu erstellen. Denke, da der Dozent die so verteilt hat, ist sie nicht "sensibel". Hatte sie jetzt nur benutzt, um eben nicht meine "Echtdaten" online zu stellen.
Dein Makro werde ich jetzt ausprobieren, auch dafür vielen Dank.
Bis gleich :-)
Gruß
Heike

AW: Tab vergleichen, farblich hervorheben
16.02.2013 19:01:03
Heike
Hallo Franz,
habe dein Makro ausprobiert, aber lösche ich beispielsweise in dem Blatt "alt" den ersten Datensatz (1011), dann markiert mir das Makro im Blatt "neu" auch Datensätze, die nicht geändert wurden. Ich glaube, dein Makro vergleicht Zeile für Zeile und diese Reihenfolge stimmt natürlich dann nicht mehr.
Aus dem Grund dachte ich, evtl. eine Abfrage auf die Personalnummer zu machen.
Hast du da noch eine Idee?
Danke dir
Gruß
Heike

Anzeige
AW: Tab vergleichen, farblich hervorheben
17.02.2013 10:12:50
fcs
Hallo Heike,
ich hatte nur mit deinen beiden Blättetrn getestet, da war mir der Fehler nicht aufgefallen.
Ich habe in einer Zeile einne Fehler, der erst auffällt, wenn man die Liste anders sortiert oder eine Zeile löscht(einfügt.
Gruß
Franz
korrigiertes Makro:
Sub VergleichenTabellen()
Dim arrAlt, arrNeu, arrIdAlt, arrIdNeu
Dim wksAlt As Worksheet
Dim wksNeu As Worksheet
Dim Spalte As Long, Spalte_L As Long
Dim ZeilenAlt As Long, ZeilenNeu As Long, varId As Variant, varZeile As Variant
Set wksAlt = Sheets("alt")
'Tabelle1 - anpassen
Set wksNeu = Sheets("neu")
'Tabelle2 - anpassen, in dieser Tabelle wird gekennzeichnet!
With wksAlt
Spalte_L = .Cells(1, .Columns.Count).End(xlToLeft).Column 'Nummer der letzten zu  _
vergleichende Spalte
ZeilenAlt = .Cells(.Rows.Count, 1).End(xlUp).Row
arrAlt = .Range(.Cells(1, 1), .Cells(ZeilenAlt, Spalte_L))
arrIdAlt = .Range(.Cells(1, 1), .Cells(ZeilenAlt, 1))
End With
With wksNeu
ZeilenNeu = .Cells(.Rows.Count, 1).End(xlUp).Row
arrNeu = .Range(.Cells(1, 1), .Cells(ZeilenNeu, Spalte_L))
arrIdNeu = .Range(.Cells(1, 1), .Cells(ZeilenNeu, 1))
'Zellfarben im Datenbereich löschen
.Range(.Cells(2, 1), .Cells(ZeilenNeu, Spalte_L)).Interior.ColorIndex = xlColorIndexNone
'Daten in markierungsspalte löschen
.Range(.Columns(Spalte_L + 1), .Columns(Spalte_L + 1)).ClearContents
End With
'Änderungen in neu markieren und nicht mehr vorhandenen in alt
For ZeilenAlt = 2 To ZeilenAlt
varId = arrIdAlt(ZeilenAlt, 1)
'Id im neuen Blatt suchen
varZeile = Application.Match(varId, arrIdNeu, 0)
If IsError(varZeile) Then
With wksAlt
.Range(.Cells(ZeilenAlt, 1), .Cells(ZeilenAlt, Spalte_L)).Interior.ColorIndex = 6
End With
Else
With wksNeu
For Spalte = 1 To Spalte_L
If arrAlt(ZeilenAlt, Spalte)  arrNeu(varZeile, Spalte) Then      '### korrigiert ### _
wksNeu.Cells(varZeile, Spalte).Interior.ColorIndex = 6
wksNeu.Cells(varZeile, Spalte_L + 1).Value = "geändert" 'Zeile markieren
End If
Next Spalte
End With
End If
Next ZeilenAlt
'Neue Zeilen in Neu markieren
For ZeilenNeu = 2 To ZeilenNeu
varId = arrIdNeu(ZeilenNeu, 1)
'Id im alten Blatt suchen
varZeile = Application.Match(varId, arrIdAlt, 0)
If IsError(varZeile) Then
With wksNeu
.Range(.Cells(ZeilenNeu, 1), .Cells(ZeilenNeu, Spalte_L)).Interior.ColorIndex = 6
wksNeu.Cells(ZeilenNeu, Spalte_L + 1).Value = "neu" 'Zeile markieren
End With
End If
Next ZeilenNeu
'Arrays zurücksetzen
Erase arrAlt, arrNeu, arrIdAlt, arrIdNeu
End Sub

Anzeige
AW: Tab vergleichen, farblich hervorheben
17.02.2013 20:45:43
Heike
Hallo Franz,
vielen Dank für deine Korrektur.
Leider markiert mir das Makro auch Zeilen, die nicht verändert (gleich) sind. Habe die Beispieldatei mit den verkehrten Markierungen noch einmal angefügt.
Ich habe in der Tabelle "neu", den Eintrag der jeweiligen Zelle rot markiert, die nicht identisch sind, mit der in Tabelle "alt", um das Makro besser testen zu können.
https://www.herber.de/bbs/user/83945.xlsm
Würdest du bitte noch einmal drüber schauen? Danke dir.
Gruß
Heike

AW: Tab vergleichen, farblich hervorheben
18.02.2013 02:39:32
fcs
Hallo Heike,
in der Beispieldatei sind die folgenden Sozialversicherungsnummern in Spalte A doppelt.
1301
1674
1675
1724
1725
1967
1968
1977
Das führt zu falchen Kennzeichnungen.
Gruß
Franz

Anzeige
Genial!!!!
18.02.2013 15:39:49
Heike
Hallo Franz,
tut mir leid, das sollte natürlich nicht sein, hab es einfach nicht gesehen! Sorry.
Werde es jetzt an der "echten" Tabelle ausprobieren, hoffe, es klappt.
Vielen vielen Dank für deine Mühe.
Viele Grüße
Heike

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige