Live-Forum - Die aktuellen Beiträge
Datum
Titel
29.03.2024 13:14:12
28.03.2024 21:12:36
28.03.2024 18:31:49
Anzeige
Archiv - Navigation
1748to1752
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

Tabellen vergleichen und markieren

Tabellen vergleichen und markieren
07.04.2020 00:21:47
Sepp
Hallo zusammen,
Ich wende mich an euch mit meinem Problem, da ich seit Tagen nach einer Lösung suche und ich einfach keine Antwort finde. Ich habe Zwei Tabellenblätter in einer Mappe, die ich vergleichen möchte. Tabelle "Alte Daten" und Tabelle "Neue Daten". Beide Tabellen sind Identisch aufgebaut. In Spalte L ab Zeile 2 sind eindeutige Auftragsnummern vergeben. Nun zu meinem Problem. Wenn sich bei gleicher Auftragsnummer die Daten in der Tabelle "Neue Daten" in Spalte M bis Z verändert haben, sollen die Zeile in "Alte Daten" überschrieben und gleichzeitig die Zellenfarbe in Rot markiert werden. Wenn bei "Neue Daten", Aufträge dazu gekommen sind, die in "Alte Daten" fehlen, sollen die Zeilen unterhalb eingefügt werden. Wenn in "Alte Daten", Aufträge sind, die in "Neue Daten" nicht mehr vorhanden sind, sollen sie in Alte Daten gelöscht werden.
Ich hoffe, einer von Euch kann mir helfen. Ich bedanke mich schon mal ganz lieb im voraus.

2
Beiträge zum Forumthread
Beiträge zu diesem Forumthread

Betreff
Datum
Anwender
Anzeige
AW: Tabellen vergleichen und markieren
08.04.2020 14:31:41
fcs
Hallo Sepp,
hier ein Makro für einen Vergleich von Tabellen mit identischem Spaltenaufbau.
LG
Franz

Sub prcVergleich_Tabellen()
Dim wksNeu As Worksheet, wksAlt As Worksheet
Dim spaKey As Long, spaV As Long, spaV1 As Long, spaV2 As Long
Dim lngAltNeu As Long
Dim zeiAlt As Long, zeiNeu As Long
Dim zeiLast_A As Long, zeiLast_N As Long
Dim arrNeu, arrAlt
Dim bolFound As Boolean, bolChanged As Boolean
Dim farbeNeu As Long, farbeGeaendert As Long
spaKey = 12 'Spalte L - Spalte mit eindeutigen Werten
spaV1 = 13  'Spalte M - 1. zu vergleichende Spalte
spaV2 = 26  'Spalte 2 - letzte zu vergleichende Spalte
farbeNeu = RGB(0, 255, 255) 'hellblau
farbeGeaendert = RGB(255, 0, 0) 'rot
Set wksAlt = ActiveWorkbook.Worksheets("Alte Daten")
Set wksNeu = ActiveWorkbook.Worksheets("Neue Daten")
With wksAlt
zeiLast_A = .Cells(.Rows.Count, spaKey).End(xlUp).Row
arrAlt = .Range(.Cells(1, 1), .Cells(zeiLast_A, spaV2))
lngAltNeu = zeiLast_A 'letzte Datenzeile merken zum Anfügen neuer Datensätze
'Füllfarbe im Datenbereich von Alt löschen
.Range(.Cells(2, spaKey), _
.Cells(zeiLast_A, spaV2)).Interior.ColorIndex = xlColorIndexNone
End With
With wksNeu
zeiLast_N = .Cells(.Rows.Count, spaKey).End(xlUp).Row
arrNeu = .Range(.Cells(1, 1), .Cells(zeiLast_N, spaV2))
End With
'Vergleichen der vorhandenen Daten in Alt
For zeiAlt = 2 To zeiLast_A
bolFound = False
For zeiNeu = 2 To zeiLast_N
If arrAlt(zeiAlt, spaKey) = arrNeu(zeiNeu, spaKey) Then
bolFound = True
bolChanged = False
For spaV = spaV1 To spaV2
If arrAlt(zeiAlt, spaV)  arrNeu(zeiNeu, spaV) Then
bolChanged = True
With wksAlt.Cells(zeiAlt, spaV)
.Value = arrNeu(zeiNeu, spaV)
.Interior.Color = farbeGeaendert
End With
End If
Next spaV
If bolChanged = True Then
wksAlt.Cells(zeiAlt, spaKey).Interior.Color = farbeGeaendert
End If
Exit For
End If
Next zeiNeu
If bolFound = False Then
wksAlt.Cells(zeiAlt, spaKey).ClearContents 'markiert zu löschende Zeilen
End If
Next zeiAlt
'Früfen, ob Daten in Neu in Alt fehlen
For zeiNeu = 2 To zeiLast_N
bolFound = False
For zeiAlt = 2 To zeiLast_A
If arrAlt(zeiAlt, spaKey) = arrNeu(zeiNeu, spaKey) Then
bolFound = True
Exit For
End If
Next zeiAlt
If bolFound = False Then
lngAltNeu = lngAltNeu + 1
wksNeu.Rows(zeiNeu).Copy wksAlt.Cells(lngAltNeu, 1)
wksAlt.Cells(lngAltNeu, spaKey).Interior.Color = farbeNeu
End If
Next zeiNeu
'nicht mehr vorhandene Datensätze löschen
With wksAlt
With .Range(.Cells(2, spaKey), .Cells(zeiLast_A, spaKey))
If Application.WorksheetFunction.CountBlank(.Cells) > 0 Then
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete shift:=xlShiftUp
End If
End With
End With
End Sub

Anzeige
AW: Tabellen vergleichen und markieren
09.04.2020 00:13:24
Sepp
Hallo Franz,
Ich bedanke mich für die schnelle Lösung. Es ist wirklich Super von euch allen, wie Ihr anderen helft, wenn sie nicht weiterkommen. Diese Forum ist echt das Beste. Frohe Ostern und nochmal Danke...

311 Forumthreads zu ähnlichen Themen

Anzeige
Anzeige
Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige

Beliebteste Forumthreads (12 Monate)

Anzeige
Anzeige
Anzeige