Public Sub Doppelte_loeschen()
'################################################
'Code für ein allgemeines Modul
'Autor: Jürgen Hennekes
'################################################
Dim objDic As Object
Dim strString As String
Dim lngZ As Long
Dim lngLast As Long
Set objDic = CreateObject("Scripting.Dictionary")
lngLast = Cells(Rows.Count, 1).End(xlUp).Row
For lngZ = lngLast To 2 Step -1
strString = Cells(lngZ, 1).Value & Cells(lngZ, 2).Value & Cells(lngZ, 3).Value _
& Cells(lngZ, 4).Value & Cells(lngZ, 5).Value
If objDic.exists(strString) = False Then
objDic(strString) = 0
Else
Cells(lngZ, 1).EntireRow.Delete
End If
Next
End Sub
|
|||||||||||||||||||||||||||||||||||||||
