AW: Doppelte Daten löschen
Uduuh
Hallo,
mit diesem Code werden alle Orte mit gleichem Namen und Übereinstimmung der ersten 2 Ziffern der PLZ gelöscht:
Sub Doppelte_loeschen()
Dim iRow As Integer, iRows As Integer
Application.ScreenUpdating = False
iRows = Cells(65536, 1).End(xlUp).Row
Range(Cells(1, 1), Cells(iRows, 2)).Sort Key1:=Range("A2"), Order1:=xlAscending, Key2:=Range( _
"B2"), Order2:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase _
:=False, Orientation:=xlTopToBottom, DataOption1:=xlSortNormal, _
DataOption2:=xlSortNormal
For iRow = iRows + 1 To 2 Step -1
If Cells(iRow, 1) = Cells(iRow + 1, 1) And Left(Cells(iRow, 2), 2) = Left(Cells(iRow + 1, 2), 2) Then
Rows(iRow + 1).EntireRow.Delete shift:=xlUp
End If
Next iRow
Application.ScreenUpdating = True
End Sub
Gruß aus'm Pott
Udo