ScreateObject("Scripting.Dictionary") Daten zuord.
Peter
Erich G. hat mir einen Code zusammengestellt (vielen Dank!), den ich etwas angepasst habe und der nun wie unten aufgeführt aussieht.
Das klappt alles wunderbar, nur habe ich noch zwei Sonderprobleme:
A) Manchmal enthält der Bereich [_Attname] nur eine Zelle, dann stopt der Code bei oDic(arQ(zz, 1)) = 0
B) Der Bereich [_Attname] ist in der Regel ein zusammenhängender Bereich in einer Spalte. Im Moment gibt es Probleme, wenn es nicht ein zusammenhängender Bereich ist, z.B. $E$11:$E$17,$E$24. Ist es möglich auch der Variable oDic die Werte von [_Attname] zuzuweisen, wenn dieser Bereich nicht zusammenhängend ist?
Vielen Dank und
Gruss, Peter
Sub ListeSortOhneDup()
''''Daten werden aus Spaltenbereich übernommen, sortiert und mehrfach Vorhandene eliminiert
Dim arQ, oDic as Object, zz As Long, arZ
arQ = [_Attname].Value
Set oDic = CreateObject("Scripting.Dictionary")
For zz = 1 To [_Attname].Cells.Count
oDic(arQ(zz, 1)) = 0 '''hier
Next
arZ = QuickSort(oDic.keys)
''''' jetzt steht die Liste in arZ(0) bis arZ(oDic.Count - 1)
For zz = 0 To oDic.Count - 1
Debug.Print zz & " / " & arZ(zz)
Next zz
End Sub
Public Function QuickSort(vSort As Variant, _
Optional ByVal lngStart As Variant, _
Optional ByVal lngEnd As Variant)
Dim i As Long
Dim J As Long
Dim h As Variant
Dim X As Variant
If IsMissing(lngStart) Then lngStart = LBound(vSort)
If IsMissing(lngEnd) Then lngEnd = UBound(vSort)
i = lngStart: J = lngEnd
X = vSort((lngStart + lngEnd) / 2)
Do
While (vSort(i) X): J = J - 1: Wend
If (i J)
If (lngStart