Tabellenabgleich mit Löschung

Hallo,
ich brauche mal wieder Hilfe (seufz). Ich habe das Archiv und die Recherche schon rauf und runter gesucht unter "Tabellen vergleichen", "Tabellen abgleichen" etc., aber alles paßte nicht so, wie ich das brauche.
Ich habe in einer Arbeitsmappe zwei Tabellen, die den gleichen Spaltenaufbau haben (4 Spalten). Die Tabellen sind in der Anzahl der Datensätze unterschiedlich. In Tabelle1 gibt es Zeilen, die nicht in Tabelle2 sind und umgekehrt.
Ich suche ein VBA-Makro, daß die Tabelle1 und Tabelle2 mit der ganzen Zeile, also allen 4 Spalten, miteinander vergleicht.
Die Zeilen, die in Tabelle1 und Tabelle2 völlig gleich sind, sollen sowohl in der Tabelle1 und auch in der Tabelle2 gelöscht werden.
Als Ergebnis sollten dann in Tabelle1 nur noch die Datensätze übrigbleiben, die in Tabelle2 nicht vorhanden sind und umgekehrt.
Über Hilfe würde ich mich sehr freuen. :-)
Gruß
Burghard

Beiträge zum Forumthread

Beiträge zu diesem Forumthread

Betreff

Datum

Anwender

Hallo Burghard,
da meine Glaskugel sonntags ihren Ruhetag hat, bin ich von folgenden Voraussetzungen ausgegangen:
1. Die beiden Tabellenblätter heißen "Tabelle1" und "Tabelle2".
2. Die Tabellen haben keine Überschriften.
3. Die vier Spalten in beiden Tabellen sind jeweils die Spalten A bis D.


Sub Burghard()
Dim wS1 As Worksheet, wS2 As Worksheet, _
sT As String, _
i As Long, j As Long, laR1 As Long, laR2 As Long
Application.ScreenUpdating = False
Set wS1 = Sheets("Tabelle1")
Set wS2 = Sheets("Tabelle2")
With wS1
laR1 = .Cells(Rows.Count, 1).End(xlUp).Row
For i = laR1 To 1 Step -1
sT = .Cells(i, 1).Text & .Cells(i, 2).Text _
& .Cells(i, 3).Text & .Cells(i, 4).Text
laR2 = wS2.Cells(Rows.Count, 1).End(xlUp).Row
For j = laR2 To 1 Step -1
If sT = wS2.Cells(j, 1).Text & wS2.Cells(j, 2).Text _
& wS2.Cells(j, 3).Text & wS2.Cells(j, 4).Text Then
.Rows(i).Delete
wS2.Rows(j).Delete
Exit For
End If
Next j
Next i
End With
With wS2
laR2 = .Cells(Rows.Count, 1).End(xlUp).Row
For i = laR2 To 1 Step -1
sT = .Cells(i, 1).Text & .Cells(i, 2).Text _
& .Cells(i, 3).Text & .Cells(i, 4).Text
laR1 = wS1.Cells(Rows.Count, 1).End(xlUp).Row
For j = laR1 To 1 Step -1
If sT = wS1.Cells(j, 1).Text & wS1.Cells(j, 2).Text _
& wS1.Cells(j, 3).Text & wS1.Cells(j, 4).Text Then
.Rows(i).Delete
wS1.Rows(j).Delete
Exit For
End If
Next j
Next i
End With
Application.ScreenUpdating = True
End Sub

Viel Erfolg wünscht
WernerB.
P.S.: Dieses Forum lebt auch von den Rückmeldungen der Fragesteller an die Antworter !

Sub Burghard() Dim wS1 As Worksheet, wS2 As Worksheet, _ sT As String, _ i As Long, j As Long, laR1 As Long, laR2 As Long Application.ScreenUpdating = False Set wS1 = Sheets("Tabelle1") Set wS2 = Sheets("Tabelle2") With wS1 laR1 = .Cells(Rows.Count, 1).End(xlUp).Row For i = laR1 To 2 Step -1 sT = .Cells(i, 1).Text & .Cells(i, 2).Text _ & .Cells(i, 3).Text & .Cells(i, 4).Text laR2 = wS2.Cells(Rows.Count, 1).End(xlUp).Row For j = laR2 To 2 Step -1 If sT = wS2.Cells(j, 1).Text & wS2.Cells(j, 2).Text _ & wS2.Cells(j, 3).Text & wS2.Cells(j, 4).Text Then .Rows(i).Delete wS2.Rows(j).Delete Exit For End If Next j Next i End With With wS2 laR2 = .Cells(Rows.Count, 1).End(xlUp).Row For i = laR2 To 2 Step -1 sT = .Cells(i, 1).Text & .Cells(i, 2).Text _ & .Cells(i, 3).Text & .Cells(i, 4).Text laR1 = wS1.Cells(Rows.Count, 1).End(xlUp).Row For j = laR1 To 2 Step -1 If sT = wS1.Cells(j, 1).Text & wS1.Cells(j, 2).Text _ & wS1.Cells(j, 3).Text & wS1.Cells(j, 4).Text Then .Rows(i).Delete wS1.Rows(j).Delete Exit For End If Next j Next i End With Application.ScreenUpdating = True End Sub

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

Tabellenabgleich mit Löschung

8 Beiträge zum Forumthread Beiträge zu diesem Forumthread

302 Forumthreads zu ähnlichen Themen

Beliebteste Forumthreads (12 Monate)

Beliebteste Forumthreads (12 Monate)

8
Beiträge zum Forumthread

Beiträge zu diesem Forumthread