VBA Macro / Remove Row duplicates|VBA & Macros|Excel Forum|My Online Training Hub

Hello

test thist Code

Sub LöschenDoppelteDatensätze()

Dim StartTime As Double
StartTime = Timer

Dim lngZeileMax As Long
Dim lngZeileMaxNeu As Long
Dim lngSpalteMax As Long
Dim i As Long

'Berechnungen ausschalten
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False
Application.EnableEvents = False

With tbl_Adressen     'Adjust the table

'Anzahl der zu prüfenden Zeilen
lngZeileMax = .Range("A" & .Rows.Count).End(xlUp).Row

'Anzahl der zu prüfenden Spalten
lngSpalteMax = .Range("A1").CurrentRegion.Columns.Count

'Datenfeld bilden, Anzahl der Spalten ist je nach Tabelle variabel!!!
ReDim Vardat(0 To lngSpalteMax - 1) As Variant

For i = 0 To lngSpalteMax - 1
Vardat(i) = i + 1
Next i

'Doppelter Datensätze löschen mit Vergleich des Datenfeldes
.Range("A1").CurrentRegion.RemoveDuplicates Columns:=(Vardat), Header:=xlYes

'Anzahl der übrig gebliebenen Zeilen
lngZeileMaxNeu = .Range("A" & .Rows.Count).End(xlUp).Row
End With

'Berechnungen wieder einschalten
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
Application.EnableEvents = True

Debug.Print "Laufzeit : " & Format((Timer - StartTime) / 86400, "hh:mm:ss:ms")
Debug.Print "Insgesamt wurden " & lngZeileMax - lngZeileMaxNeu & " Zeilen gelöscht"

End Sub