|
Hallo zusammen,
In Spalte A hab ich eine quasi unendliche Anzahl Nummern.
Ich möchte, dass mir in Spalte E alle eindeutigen wiedergegeben werden.
Ich erhalte keine Fehlermeldung, es passiert einfach nullkommanichts ...
Sub DoppelteWerteLöschenMitDemDictionaryObjekt()
Dim objSD As Object
Dim VarDat As Variant
Dim VarDatAus As Variant
Dim i As Integer
Set objSD = CreateObject("scripting.dictionary")
'Array füllen
With Tabelle18
.Range("E:E").ClearContents
VarDat = .Range(.Cells(1, 1), .Cells(.Rows.Count, _
1).End(xlUp)).Value
End With
'Dictionary-Objekt befüllen, nur unikate Einträge aufnehmen
For i = LBound(VarDat) To UBound(VarDat)
If objSD.Exists(VarDat(i, 1)) = False Then
objSD.Add VarDat(i, 1), ""
End If
Next i
'Übergabe der eindeutigen Schlüssel an das Array
VarDatAus = objSD.Keys
'Ausgabe des Arrays in Tabelle2 (senkrecht)
With Tabelle18
.Range(.Cells(1, 5), .Cells(objSD.Count, 5)).Value = _
WorksheetFunction.Transpose(VarDatAus)
End With
Set objSD = Nothing
End Sub
|