VB 5/6-Tipp 0188: Sortieren mit Quicksort

'Dieser Quellcode stammt von http://www.activevb.de
'und kann frei verwendet werden. Für eventuelle Schäden
'wird nicht gehaftet.

'Um Fehler oder Fragen zu klären, nutzen Sie bitte unser Forum.
'Ansonsten viel Spaß und Erfolg mit diesem Source!

'------------- Anfang Projektdatei Project1.vbp -------------
'--------- Anfang Formular "Form1" alias Form1.frm  ---------
' Steuerelement: Schaltfläche "Command2"
' Steuerelement: Listen-Steuerelement "List2"
' Steuerelement: Schaltfläche "Command1"
' Steuerelement: Listen-Steuerelement "List1"

Option Explicit

Dim Feld(0 To 500) As String

Private Sub Form_Load()
    Call Shuffle
End Sub

Private Sub Command1_Click()
    Dim X As Integer
  
    Call QuickSort(LBound(Feld), UBound(Feld))
    List2.Clear
  
    For X = 0 To UBound(Feld)
        List2.AddItem Feld(X)
    Next X
End Sub

Private Sub Command2_Click()
    Call Shuffle
End Sub

Private Sub QuickSort(ByVal LB As Long, ByVal UB As Long)
    Dim P1 As Long, P2 As Long, Ref As String, TEMP As String

    P1 = LB
    P2 = UB
    Ref = Feld((P1 + P2) / 2)
    
    Do
        Do While (Feld(P1) < Ref)
            P1 = P1 + 1
        Loop
 
        Do While (Feld(P2) > Ref)
            P2 = P2 - 1
        Loop

        If P1 <= P2 Then
            TEMP = Feld(P1)
            Feld(P1) = Feld(P2)
            Feld(P2) = TEMP
            
            P1 = P1 + 1
            P2 = P2 - 1
        End If
    Loop Until (P1 > P2)

    If LB < P2 Then Call QuickSort(LB, P2)
    If P1 < UB Then Call QuickSort(P1, UB)
End Sub

Private Sub Shuffle()
    Dim X As Integer, y As Integer, aa As String
    
    List1.Clear
    Randomize
    For X = 0 To UBound(Feld)
        aa = ""
        For y = 0 To 5
            aa = aa & Chr$(Rnd * 25 + 65)
        Next y
        List1.AddItem aa
        Feld(X) = aa
    Next X
End Sub
'---------- Ende Formular "Form1" alias Form1.frm  ----------
'-------------- Ende Projektdatei Project1.vbp --------------

Kommentar von cusdom am 11.09.2008 um 14:40

Für vb.net und etwas Modifiziert (sortiert Integer):
Public Sub QuickSortInteger(ByVal intArr() As Integer, Optional ByVal LB As Integer = 0, Optional ByVal UB As Integer = 0)
Dim P1 As Long
Dim P2 As Long
Dim Ref As Integer
Dim TEMP As Integer

Dim lower As Integer
Dim upper As Integer
If LB = 0 Then
lower = LBound(intArr)
Else
lower = LB
End If
If UB = 0 Then
upper = UBound(intArr)
Else
upper = UB
End If


P1 = lower
P2 = upper
Ref = intArr((P1 + P2) / 2)

Do
Do While (intArr(P1) < Ref)
P1 = P1 + 1
Loop

Do While (intArr(P2) > Ref)
P2 = P2 - 1
Loop

If P1 <= P2 Then
TEMP = intArr(P1)
intArr(P1) = intArr(P2)
intArr(P2) = TEMP

P1 = P1 + 1
P2 = P2 - 1
End If
Loop Until (P1 > P2)

If LB < P2 Then
QuickSortInteger(intArr, lower, P2)
End If

If P1 < UB Then
QuickSortInteger(intArr, P1, upper)
End If

End Sub

Kommentar von Michaela am 31.12.2007 um 00:23

Ich kann der "StrComp"-Methode nur beipflichten, weil sehr schnell, wenn man sie korrekt anwendet.

Kommentar von teddyd am 19.07.2007 um 19:07

fritzfilzlaus: Für absteigende Sortierung einfach bei den beiden Ref-Vergleichen die Größer/Kleiner Zeichen wechseln, also aus

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Do While (Feld(P1) < Ref)
P1 = P1 + 1
Loop

Do While (Feld(P2) > Ref)
P2 = P2 - 1
Loop
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

wird

>>>>>>>>>>>>>>>>>>>>>>>>>>>>>
Do While (Feld(P1) > Ref)
P1 = P1 + 1
Loop

Do While (Feld(P2) < Ref)
P2 = P2 - 1
Loop
>>>>>>>>>>>>>>>>>>>>>>>>>>>>>

:-)

Kommentar von vn am 20.03.2007 um 10:53

Für Ästheten und Erbsenzähler noch ein Verbesserungsvorschlag

Private Sub QuickSort(ByRef Feld() As Long, ByVal LB As Long, ByVal UB As Long)

"Feld" kann auch als Variable in den rekursiven Aufruf mit aufgenommen werden.

Kommentar von fritzfilzlaus am 11.02.2007 um 12:23

Hallo, wie muss der Code verändert werden, damit er das Array absteigend (Z, Y, ...) sortiert? :-)

Kommentar von Martin am 12.04.2005 um 16:23

Der Quicksort funktioniert prima. Habe aber noch einen Verbesserungsvorschlag. Die Vergleiche:

Do While (Feld(P1) < Ref)

und

Do While (Feld(P2) > Ref)

beachten die Besonderheiten bei nationalen Sonderzeichen nicht. So tauchen z. B. Ä's, Ö's und Ü's in der Liste hinten auf. Man kann dies aber recht einfach beheben:

Do While StrComp(Feld(P1), Ref, vbTextCompare) = -1

und

Do While StrComp(Feld(P2), Ref, vbTextCompare) = 1

Kommentar von viba6 am 03.09.2003 um 17:20

Einfach klasse der Code. Hab ihn bei einer klassischen Versetzungschiffre eingesetzt um den Schlüssel zu ordnen - sehr schnell und gut nachvollziehbar!
viba

Kommentar von Phantomix am 03.06.2003 um 11:05

Quicksort rulez! Hab das ding in informatik auf nem 286er gesehn wie er in 1 Sekunde einen 32767 integer array sortierte!!!

Kommentar von Michael am 16.04.2002 um 15:33

Ich hätte da noch eine grundlegende Frage :)
Wie sieht das ganze bei String Arrays mit über 32000 Zeilen aus ?

Kommentar von Herfried Wagner am 25.03.2002 um 20:10

Schau mal in http://www.ActiveVB-Archiv.de/VZ-Hirf/sortandsearch.zip in das Sorting-Beispiel.
Grüsse,
Hirf

Kommentar von Uwe am 01.10.2001 um 15:03

Klasse Code
Ich verwende ihn in MindManager mit SaxBasic und der Code funktioniert einwandfrei und sauschnell.
Uwe

Kommentar von peter straschok am 25.05.2001 um 14:37

Der Tipp ist genial und funktioniert fuer jede feldgroese, besonders auch bei dynamischen felder.
Zu Pete: Lieber Pete, die 500 ist ein reiner beispiel wert. man hat sowieso meistens mit dynamischen feldern zu tue, die mir redim preserve... entsprechend angepasst werden. zum Author: einfach nur genial.

Kommentar von Tom Kericht am 30.01.2001 um 05:43

Hi Pete, na das gleiche wie bei einer geraden Zahl. Das ist vollkommen irrelevant, da es sich wie der Variablennamen schon nahe legt, lediglich um einen Referenzewert handelt. Ergäbe sich eine ungerade Zahl bei der Teilung, ist der Referenzwert schlimmstenfalls der kleinste Teil der Zerlegung und würde mit sich selbst verglichen, was wiederum die Sortierfolge nicht stört.

Kommentar von pete am 30.01.2001 um 04:31

der tip ist ja ganz nett, aber was passiert bei einer feldgrösse, von 501, wenn also (p1 + p2) /2 keine ganze zahl ist? bzw. wie kann ich das problem umgehen?
thx