[[EID]-Mr.GiZMO]

Ich hab was gecodet!

Vorraussetung:
- Spalte 1 - Nr oder so
- Spalte 2 - Name

Das tut das Makro:
- Zählt Anzahl der Zeilen (also hier Datensätze)
- sortiert nach Name (Spalte 2)
- schaut von unten nach oben (musste ich jetzt auf die Schnelle so coden) nach gleichen Namen in zwei übereinanderstehenden Zeilen
- löscht die untere
- funktioniert auch bei 3, 4, 5... gleichen Namen
- behalten wird sortiertechnisch die Zeile mit der kleinsten Zahl in Spalte 1
- am Ende wieder nach Spalte 1 sortiert


Et voila:

' ANZAHL ZEILEN LESEN
    Function Zeilenzahl() As Integer
        Range("A1").Select
        Zeilenzahl = Selection.CurrentRegion.Rows.Count
    End Function
    

Sub Dupletten_loeschen()
'
' Dupletten_loeschen Makro
'

' SORTIEREN
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("B1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range("A1:B" & Zeilenzahl())
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    
' VON UNTEN NACH OBERN DUPLETTEN LÖSCHEN
    Dim i As Integer
    
    For i = (Zeilenzahl() - 1) To 2 Step -1
        If Worksheets("Tabelle1").Cells(i - 1, 2) = Worksheets("Tabelle1").Cells(i, 2) Then Selection.Rows(i).EntireRow.Delete
    Next i
    
' WIEDER NACH NUMMER SORTIEREN
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Clear
    ActiveWorkbook.Worksheets("Tabelle1").Sort.SortFields.Add Key:=Range("A1"), _
        SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
    With ActiveWorkbook.Worksheets("Tabelle1").Sort
        .SetRange Range("A1:B" & Zeilenzahl())
        .Header = xlNo
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
     
End Sub

Einfach per Alt+F11 VB öffnen und in ein Modul deiner Wahl packen.


Bei gewünschten Korrekturen, bitte melden.


So, back to work