Makro Excel?

1 Antwort

Sub NurDuplikateBehalten()

Dim letzteZeile As Long

Dim i As Long

Dim dict As Object

' Dictionary erstellen

Set dict = CreateObject("Scripting.Dictionary")

' Letzte Zeile in Spalte B finden

letzteZeile = Cells(Rows.Count, "B").End(xlUp).Row

' Alle Werte zählen

For i = 1 To letzteZeile

If Not IsEmpty(Cells(i, "B").Value) Then

dict(Cells(i, "B").Value) = dict(Cells(i, "B").Value) + 1

End If

Next i

' Von unten nach oben durchgehen und eindeutige Zeilen löschen

For i = letzteZeile To 1 Step -1

If Not IsEmpty(Cells(i, "B").Value) Then

If dict(Cells(i, "B").Value) = 1 Then

Rows(i).Delete

End If

End If

Next i

MsgBox "Fertig! Nur Duplikate bleiben erhalten.", vbInformation

End Sub


Rose2310 
Beitragsersteller
 26.04.2025, 20:07

Ich danke dir!!