|
Hallo,
würde ich mit RemoveDuplicates machen, das ist wesentlich schneller, als zeilenweise zu löschen.
Zunächst wird in die erste freie Spalte am Ende eine Formel eingefügt, die alle Datensätze markiert, die gelöscht werden sollen.
Anschließend werden die so markierten Datensätze über RemoveDuplicates gelöscht.
Vorraussetzung: Wenn nicht schon vorhanden in Zeile 1 Überschriften einfügen.
Public Sub Doppelte_raus()
Dim loLetzte As Long, loSpalte As Long
Application.ScreenUpdating = False
'Blattname anpassen
With Worksheets("Tabelle1")
loLetzte = .Cells(.Rows.Count, "R").End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
With .Range(.Cells(2, loSpalte), .Cells(loLetzte, loSpalte))
.FormulaLocal = "=WENN(UND(ZÄHLENWENN($Q2:$Q" & loLetzte & ";$Q2)>1;$R2=""J"");0;ZEILE())"
.Value = .Value
End With
.Cells(1, loSpalte) = 0
.Range(.Cells(1, "A"), .Cells(loLetzte, loSpalte)).RemoveDuplicates Columns:=loSpalte, Header:=xlNo
.Columns(loSpalte).ClearContents
End With
End Sub
Gruß Werner
|