Sub DoppelteWeg()
Dim i As Integer, iRows As Integer
iRows = Cells(Cells.Rows.count, 1).End(xlUp).Row
For i = iRows To 1 Step -1
If WorksheetFunction.CountIf(Columns(1), Cells(i, 1)) > 1 Then
Rows(i).Delete
End If
Next i
End Sub
Sub test()
Dim zelle As Range
Dim container As Variant
Dim i As Long
Dim a As Long
container = Array()
With Application
.Calculation = xlCalculationManual
.ScreenUpdating = False
.EnableEvents = False
End With
For Each zelle In Range("a1:a1000")
If WorksheetFunction.CountIf(Range("A1:a1000"), zelle) > 1 Then
ReDim Preserve container(i)
container(i) = zelle.Row
i = i + 1
End If
Next
For a = UBound(container) To LBound(container) Step -1
Rows(container(a)).Delete
Next
With Application
.Calculation = xlCalculationAutomatic
.ScreenUpdating = True
.EnableEvents = True
End With
End Sub
Die erweiterte Suchfunktion hilft dir, gezielt die besten Antworten zu finden
Suche nach den besten AntwortenEntdecke unsere meistgeklickten Beiträge in der Google Suche
Top 100 Threads jetzt ansehen