Sub DoppelteWerteLöschenMitDemDictionaryObjekt()
Dim objSD As Object
Dim VarDat As Variant
Dim VarDatAus As Variant
Dim i As Integer
Set objSD = CreateObject("scripting.dictionary")
With Tabelle18
.Range("E:E").ClearContents
VarDat = .Range(.Cells(1, 1), .Cells(.Rows.Count, _
1).End(xlUp)).Value
End With
For i = LBound(VarDat) To UBound(VarDat)
If objSD.Exists(VarDat(i, 1)) = False Then
objSD.Add VarDat(i, 1), ""
End If
Next i
VarDatAus = objSD.Keys
With Tabelle18
.Range(.Cells(1, 5), .Cells(objSD.Count, 5)).Value = _
WorksheetFunction.Transpose(VarDatAus)
End With
Set objSD = Nothing
End Sub