Doppelte Werte - 3 Spalten Vergleich
03.11.2005 19:59:34
Burghard
ich brauche Hilfe. Vor einiger Zeit hat mir jemand aus diesem Forum das nachfolgende Makro geschrieben. Es vergleicht alle Spalten der Tabelle1 mit allen Spalten der Tabelle2. Dabei werden alle Zeilen, die gleich sind, gelöscht.
Ich brauche dieses Makro noch etwas verändert und zwar sollen nur die ersten drei Spalten der Tabelle1 mit den ersten drei Spalten der Tabelle2 verglichen werden. Alles andere soll gleich bleiben.
Kann jemand diese Änderung in das Makro einfügen? Wäre super.
Schönen Gruß
Burghard
Sub Vergleich_mit_loeschen_Tabelle1_Tabelle2()
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