Hallo,
ohne Schleife. Zählenwenns-Formel in die erste freie Spalte. Über die Formel wird bei Doppelten eine 0 und bei Einfachen die Zeilennummer in die erste freie Spalte eingetragen. Dann noch eine 0 in die erste Zeile und mit Remove-Duplicates auf die erste freie Spalte die Zeilen mit 0 entfernen.
Public Sub Doppelte_raus()
Dim loZeile As Long, loSpalte As Long
With Worksheets("Tabelle3")
loZeile = .Cells(.Rows.Count, "A").End(xlUp).Row
loSpalte = .Cells(1, .Columns.Count).End(xlToLeft).Offset(, 1).Column
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).FormulaLocal = _
"=WENN(ZÄHLENWENNS($B$2:$B$" & loZeile & ";B2;$C$2:$C$" & loZeile & ";C2)>1;0;ZEILE())"
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).Value = _
.Range(.Cells(2, loSpalte), .Cells(loZeile, loSpalte)).Value
.Cells(1, loSpalte) = 0
.Range(.Cells(1, 1), .Cells(loZeile, loSpalte)).RemoveDuplicates Columns:=loSpalte, _
Header:=xlNo
.Columns(loSpalte).ClearContents
End With
End Sub
Gruß Werner
|