AW: Doppelte Zeilen löschen- 2 Spalten als Kriterium
07.01.2009 19:16:33
Daniel
Hi
hier ein Marko zum Löschen der Duplikate in Spalte A, B und E.
um es zum auf die Duplikaten in A und E anzupassen, muss der fette Teil aus dem Code entfernt werden.
Sub DoppelteLöschen()
Dim sp As Long
Dim ze As Long
'--- Tabellengrösse feststellen
sp = Cells(1, Columns.Count).End(xlToLeft).Column
ze = Cells(Rows.Count, 1).End(xlUp).Row
'--- Original-Reihenfolge sichern
With Cells(1, sp + 1).Resize(ze, 1)
.FormulaR1C1 = "=Row()"
.Formula = .Value
End With
'--- Daten umsortieren für höhere Geschwindigkeit
Range("A1").CurrentRegion.Sort _
Key1:=Range("A2"), order1:=xlAscending, _
Key2:=Range("E2"), order1:=xlAscending, _
Key3:=Range("B2"), order1:=xlAscending, _
header:=xlYes
'--- Doppelte Datensätze mit Formel markieren und löschen
With Cells(2, sp + 2).Resize(ze - 1, 1)
.FormulaR1C1 = "=IF(AND(RC1=R[-1]C1,RC2=R[-1]C2,RC5=R[-1]C5),"""",RC[-1])"
.Formula = .Value
.CurrentRegion.Sort Key1:=Cells(2, sp + 2), order1:=xlAscending, header:=xlYes
.SpecialCells(xlCellTypeBlanks).EntireRow.Delete
End With
Cells(1, sp + 1).Resize(ze, 2).ClearContents
End Sub
die Bedingungen, damit das Makro funktioniert:
- die Tabelle an sich ist geschlossen, dh sie enthält keine Leerzeilen und -Spalten
- die Tabelle hat eine einzeilige Überschrift
- die Tabelle darf umsortiert werden (allerdings wird die originalsortierung am Ende wieder hergestellt)
- das Blatt enthält außer der Tabelle keine weiteren Daten
Gruß, Daniel