QuickSort arrDaten

Question

Hallo Exelfreunde,
ist es möglich durch QuickSort arrDaten die Einträge (Spalte A Datum) von unten nach oben zu sortieren, also die letzten Einträge zuerst?

Ich hoffe ihr habt eine Idee dazu.

Gruß
fedjo


Application.ScreenUpdating = False
Dim objDictionary As Object
Dim varBereich As Variant
Dim arrDaten As Variant
Dim loZaehler As Long

UserForm2.ComboBox3.Clear 'Datum
Set objDictionary = CreateObject("Scripting.Dictionary")
varBereich = Range("A3", Range("A3").End(xlDown))
For loZaehler = LBound(varBereich) To UBound(varBereich)
' Eintrag wird nur übernommen wenn er im DictionaryObject noch nicht enthalten ist
objDictionary(varBereich(loZaehler, 1)) = 0
Next loZaehler
arrDaten = objDictionary.keys
QuickSort arrDaten
UserForm2.ComboBox3.List = arrDaten
Set objDictionary = Nothing
End Sub

Answer 1

Hallo fedjo,

Im nachfolgenden Link ist was von absteigend sortieren die Rede

QuickSort

Vielleicht ist es für Dich brauchbar, wenn nicht ab in den Papierkorb.

Gruß

Paul1

Answer 2

Hallo Paul,
soweit ich den Code aus dem Link versehe, wird in der Tabelle sortiert, ich benötige die Sortierung aber in einer UserForm2.ComboBox3.

Danke für den Hinweis.

Gruß
fedjo

Answer 3

Hi Fedjo,

es wird nicht im Tabellenblatt sortiert sondern in einem Array und das Ergebnis wird anschließend im Tabellenblatt ausgegeben.

Bis später,
Karin

Answer 4

Hallo Karin,
wie muß ich den Code anpassen, damit das Ergebnis aus " A3:A20000" in der UserForm2.ComboBox3.List angezeigt wird?

Gruß
fedjo

Public Sub Teste_QuickSort_Feld()
Dim vX As Variant
vX = Array("B", "Z", "A", "R")
QuickSort_Feld vX, 0, UBound(vX), False
Range("b2:e2") = vX ' Testausgabe
vX = Array("B", "Z", "A", "R")
QuickSort_Feld vX, 0, UBound(vX), True
Range("b3:e3") = vX ' Testausgabe
End Sub

Answer 5

Hi Fedjo,

im Prinzip wie in deinem Eröffnungsbeitrag (nur dass du dort den Code für das QuickSort vergessen hast zu posten).

Bis später,
Karin

Answer 6

Hi Karin,
vielleicht könntest Du noch mal einen Blick auf den Code schmeißen und mir einen Tipp geben.

Danke

Gruß
fedjo

Application.ScreenUpdating = False
Dim objDictionary As Object
Dim varBereich As Variant
Dim arrDaten As Variant
Dim loZaehler As Long

UserForm2.ComboBox3.Clear 'Datum
Set objDictionary = CreateObject("Scripting.Dictionary")
varBereich = Range("A3", Range("A3").End(xlDown))
For loZaehler = LBound(varBereich) To UBound(varBereich)
' Eintrag wird nur übernommen wenn er im DictionaryObject noch nicht enthalten ist
objDictionary(varBereich(loZaehler, 1)) = 0
Next loZaehler
arrDaten = objDictionary.keys
QuickSort arrDaten
UserForm2.ComboBox3.List = arrDaten
Set objDictionary = Nothing
End Sub


Sub QuickSort(ByRef VA_Array, Optional V_Low1, Optional V_High1)
' http://www.herber.de/forum/archiv/108to112/t109556.htm
On Error Resume Next
Dim V_Low2 As Long, V_High2 As Long
Dim V_Val1, V_Val2 As Variant
If IsMissing(V_Low1) Then
V_Low1 = LBound(VA_Array, 1)
End If
If IsMissing(V_High1) Then
V_High1 = UBound(VA_Array, 1)
End If
V_Low2 = V_Low1
V_High2 = V_High1
V_Val1 = VA_Array((V_Low1 + V_High1) / 2)
While (V_Low2 <= V_High2)
While (VA_Array(V_Low2) < V_Val1 And _
V_Low2 < V_High1)
V_Low2 = V_Low2 + 1
Wend
While (VA_Array(V_High2) > V_Val1 And _
V_High2 > V_Low1)
V_High2 = V_High2 - 1
Wend
If (V_Low2 <= V_High2) Then
V_Val2 = VA_Array(V_Low2)
VA_Array(V_Low2) = VA_Array(V_High2)
VA_Array(V_High2) = V_Val2
V_Low2 = V_Low2 + 1
V_High2 = V_High2 - 1
End If
Wend
If (V_High2 > V_Low1) Then Call _
QuickSort(VA_Array, V_Low1, V_High2)
If (V_Low2 < V_High1) Then Call _
QuickSort(VA_Array, V_Low2, V_High1)
End Sub

Answer 7

Hi Fedjo,

folgende Kombination aus beiden müsste funktionieren. Versuche es mal so (den Teil mit der ComboBox im UserForm kann ich nicht prüfen da mir deine Mappe nicht vorliegt):

Sub Sortieren()
Dim objDictionary As Object
Dim varBereich As Variant
Dim arrDaten() As Variant
Dim loZaehler As Long
Application.ScreenUpdating = False
UserForm2.ComboBox3.Clear 'Datum
Set objDictionary = CreateObject("Scripting.Dictionary")
varBereich = Range("A3", Range("A3").End(xlDown))
For loZaehler = LBound(varBereich) To UBound(varBereich)
' Eintrag wird nur übernommen wenn er im DictionaryObject noch nicht enthalten ist
objDictionary(varBereich(loZaehler, 1)) = 0
Next loZaehler
arrDaten() = objDictionary.keys
QuickSort_Feld arrDaten, 0, UBound(arrDaten()), True
UserForm2.ComboBox3.List = arrDaten()
Set objDictionary = Nothing
End Sub

Private Sub QuickSort_Feld(DasFeld, StartUnten, EndeOben, Absteigend As Boolean)
'QuickSort Standard
Dim iUnten As Long, iOben, iMitte, y
iUnten = StartUnten
iOben = EndeOben
iMitte = DasFeld((StartUnten + EndeOben) / 2)
While (iUnten <= iOben)
If Not Absteigend Then
While (DasFeld(iUnten) < iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte < DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
Else
While (DasFeld(iUnten) > iMitte And iUnten < EndeOben)
iUnten = iUnten + 1
Wend
While (iMitte > DasFeld(iOben) And iOben > StartUnten)
iOben = iOben - 1
Wend
End If
If (iUnten <= iOben) Then
y = DasFeld(iUnten)
DasFeld(iUnten) = DasFeld(iOben)
DasFeld(iOben) = y
iUnten = iUnten + 1
iOben = iOben - 1
End If
Wend
If (StartUnten < iOben) Then Call QuickSort_Feld(DasFeld, StartUnten, iOben, Absteigend)
If (iUnten < EndeOben) Then Call QuickSort_Feld(DasFeld, iUnten, EndeOben, Absteigend)
End Sub

Bis später,
Karin

Answer 8

Hi Karin,
ich deinen Code eingefügt, jetzt wird ein Fehler (UserForm2.Show) beim öffnen der UserForm angezeigt.
Hast Du dazu noch eine Idee, oder soll ich eine Musterdatei hochladen?

Gruß
fedjo

Answer 9

Hi Fedjo,

wie ich das sehe, liegt es nicht am Code für das Sortieren sondern am UserForm - und das kann ich ohne vorliegende Arbeitsmappe nicht testen.

Bis später,
Karin

Answer 10

Hallo Karin,
hier die Musterdaei, ich hoffe Du kannst mir weiterhelfen.

Gruß
fedjo