Sortieralgorithmen im Vergleich Mit diesem Workshop stellen wir Ihnen 9 verschiedene Algorithmen für das Sortieren von Array-Inhalten vor und vergleichen die benötigte Zeit bei 5.000 Array-Elementen.
Autor:  Norbert Grimm	Bewertung:     [ Jetzt bewerten ]	Views:  19.965

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 19 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.8 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Bevor wir Ihnen die einzelnen Sortierverfahren näher vorstellen, hier zunächst schon einmal vorab das Testergebnis:

Nr. Methode Shell-Faktor 1 Shell 1 2 Heap 5.5 3 Quick 21 4 AusTausch_1 30 5 VB_SortData 36 6 AusTausch 63.5 7 Einfuege 243 8 Bubble 298 9* VB_Quick 0.75 (neu 03.04.2008)

Faktor: x-fache der ShellZeit (bez.5000 Elemente), die Shell-Methode ist der schnellste Algorithmus.

Hilfsfunktion zum Tauschen zweier Variablen

' SWAP : QuickBasic 4.5
'      : nachprogrammiert
Private Function XSwap(vSortDat0 As Variant, vSortDat1 As Variant) As Integer
  Dim Ret     As Long
  Dim Vorher  As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_XSwap
 
  Vorher = vSortDat1
  vSortDat1 = vSortDat0
  vSortDat0 = Vorher
 
Exit_XSwap:
  XSwap = Ret
  Exit Function
 
Err_XSwap:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_XSwap
End Function

ShellSort
Shellsort ist ein von Donald L. Shell im Jahre 1959 entwickeltes Sortierverfahren, das auf dem Sortierverfahren des direkten Einfügens (Insertionsort) basiert.

Insertionsort: (engl. insertion – das Einfügen, sort – sortieren) ist ein einfaches stabiles Sortierverfahren. Es ist weit weniger effizient als andere anspruchsvollere Sortierverfahren. Dafür hat es jedoch folgende Vorteile: Es ist einfach zu implementieren, effizient bei (ziemlich) kleinen Eingabemengen, effizient bei Eingabemengen, die schon vorsortiert sind, stabil (d.h. die Reihenfolge von schon sortierten Elementen ändert sich nicht) und minimal im Speicherverbrauch, da der Algorithmus ortsfest arbeitet. Der Algorithmus entnimmt der unsortierten Eingabefolge ein beliebiges (z.B. das erste) Element und fügt es an richtiger Stelle in die (anfangs leere) Ausgabefolge ein. Geht man hierbei in der Reihenfolge der ursprünglichen Folge vor, so ist das Verfahren stabil. Wird auf einem Array gearbeitet, so müssen die Elemente hinter dem neu eingefügten Element verschoben werden. Dies ist die eigentlich aufwändige Operation von Insertionsort, da das Finden der richtigen Einfügeposition über eine binäre Suche vergleichsweise effizient erfolgen kann.

' ==============================================================================
' Beschreibung :
' 
' Die Prozedur ShellSort ist ähnlich zu der Prozedur BubbleSort. ShellSort
' startet jedoch damit, daß sie weit auseinanderliegende Elemente vergleicht
' (getrennt durch den Wert der Variablen Offset, der zu Beginn die Hälfte des
' Abstandes zwischen dem ersten und letzten Element ist) und anschließend
' Elemente vergleicht, die näher zusammenliegen (wenn Offset eins ist, ist
' die letzte Iteration dieser Prozedur gleich der Prozedur BubbleSort).
' ==============================================================================
'
' Funktion     : ShellSort
'
' Parameter    : vArray
'              : vArray(1 to x, 1)
'              : 2-dimensionales Variant_Array
' vArray(x, 0) : Position, SatzNr
' vArray(x, 1) : zu sort.Begriff
'
' Bearbeitet   : Norbert.Grimm
'
Function ShellSort(ByRef vArray() As Variant) As Long
  Dim I           As Long
  Dim UB          As Long
  Dim L           As Long
  Dim Limit       As Long
  Dim MaxZeile    As Long
  Dim OffSet      As Long
  Dim Tauschen    As Long
  Dim Ret         As Long
  Dim Min         As Long
  Dim min0        As Variant
  Dim min1        As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_ShellSort
 
  UB = UBound(vArray)
 
  ' vArray(x, 0) : Position, SatzNr
  ' vArray(x, 1) : zu sort.Begriff
  '
  ' Setze den Vergleichsoffset auf die Hälfte der Satzzahl in vArray(x,1):
 
  MaxZeile = UB
 
  OffSet = MaxZeile \ 2           ' Ganzzahl_Division (Rundung nach unten)
 
  Do While OffSet > 0             ' Wiederhole, bis Offset null wird.
    Limit = MaxZeile - OffSet
 
    Do
      Tauschen = 0            ' Nimm an, daß bei diesem Offset nicht
                              ' getauscht wird.
 
      ' Vergleiche die Elemente und vertausche diejenigen, die nicht 
      ' in der richtigen Reihenfolge liegen:
      ' For I = 1 To Limit
      '   Min = I + OffSet
 
      ' Verwende absteigende Schleife (2-3 fach schneller als mit 
      ' aufsteigender Logik)
      For I = Limit To 1 Step -1
        Min = I + OffSet
        If vArray(I, 1) > vArray(Min, 1) Then
          min0 = vArray(Min, 0)        ' Formulierung ist
          min1 = vArray(Min, 1)        ' schneller als XSWAP
          vArray(Min, 0) = vArray(I, 0)
          vArray(Min, 1) = vArray(I, 1)
          vArray(I, 0) = min0
          vArray(I, 1) = min1
 
          Tauschen = I
        End If
      Next I
 
      ' Sortiere im nächsten Schritt nur bis dahin, wo der letzte 
      ' Tausch durchgeführt wurde:
      Limit = Tauschen - OffSet
    Loop While Tauschen
 
    ' Kein Tausch beim letzten Offset, versuche es mit dem halbierten
    ' Offset:
 
    OffSet = OffSet \ 2
  Loop
 
Exit_ShellSort:
  ShellSort = Ret
  Exit Function
 
Err_ShellSort:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_ShellSort
End Function

HeapSort
Die Prozedur HeapSort funktioniert, indem sie zwei andere Prozeduren aufruft - FilternAufw und FilternAbw. FilternAufw wandelt SortDatFeld in einen "heap" um, dessen Eigenschaften das unten gezeigte Diagramm verdeutlicht:

 
'                             vArray(1,1)
'                           /            \
'                vArray(2,1)              vArray(3,1)
'               /           \            /            \
'         vArray(4,1)    vArray(5,1)     vArray(6,1)   vArray(7,1)
'          /      \       /       \       /      \      /      \
'        ...      ...   ...       ...   ...      ...  ...      ...

wobei jeder "Eltern-Knoten" größer ist als jeder seiner "Kind-Knoten"; zum Beispiel ist vArray(1,1)) größer als vArray(2,1) oder vArray(3,1), vArray(3,1) ist größer als vArray(6,1) oder vArray(7,1) und so weiter.

Nachdem die erste FOR...NEXT-Schleife in HeapSort beendet ist, befindet sich das größte Element daher in vArray(1,1).

Die zweite FOR...NEXT-Schleife in HeapSort vertauscht das Element in (vArray(X,1) mit dem Element in MaxZeile, bildet den Heap erneut (mit FilternAbw) für MaxZeile - 1, vertauscht anschließend das Element in (vArray(X,1) mit dem Element in MaxZeile - 1, bildet den Heap erneut für MaxZeile - 2 und fährt in dieser Art und Weise fort, bis das Datenfeld sortiert ist.

Function HeapSort(ByRef vArray() As Variant) As Long
  Dim I        As Long
  Dim MaxZeile As Long
  Dim Ret      As Long
 
  ' Fehlerroutine
  On Error GoTo Err_HS
 
  MaxZeile = UBound(vArray)
 
  For I = 2 To MaxZeile
    FilternAufw I, vArray
  Next I
 
  For I = MaxZeile To 2 Step -1
    XSwap vArray(1, 0), vArray(I, 0)
    XSwap vArray(1, 1), vArray(I, 1)
    FilternAbw I - 1, vArray
  Next I
 
Exit_HS:
  HeapSort = Ret
  Exit Function
 
Err_HS:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_HS
End Function

' ============================== FilternAufw =================================
'   Die Prozedur FilternAufw überträgt die Elemente von 1 bis MaxEbene in
'   SortDatFeld in einen "heap" (siehe das Diagramm in der Prozedur HeapSort).
' ============================================================================
' 
Private Function FilternAufw(ByVal MaxEbene As Long, ByRef vArray As Variant) As Long
  Dim I       As Long
  Dim Eltern  As Long
  Dim Ret     As Long
 
  ' Fehlerroutine
  On Error GoTo Err_Aufw
 
  I = MaxEbene
 
  ' Bewege den Wert in vArray(MaxEbene,1) solange durch den Heap nach
  ' oben, bis er seinen richtigen Knoten erreicht hat (das heiát, bis der
  ' Wert größer als irgendeiner seiner Kind-Knoten ist, oder er 1, die
  ' Spitze des Heaps, erreicht hat):
 
  Do Until I = 1
    Eltern = I \ 2        ' Lies den Index des Eltern-Knotens.
 
    ' Der Wert des aktuellen Knotens ist noch größer als der Wert seines
    ' Eltern-Knotens, also vertausche diese beiden Datenfeldelemente:
    If vArray(I, 1) > vArray(Eltern, 1) Then
      XSwap vArray(Eltern, 0), vArray(I, 0)
      XSwap vArray(Eltern, 1), vArray(I, 1)
 
      I = Eltern
      ' Andernfalls hat das Element in dem Heap seine richtige Position
      ' erreicht, also verlasse diese Prozedur:
    Else
      Exit Do
    End If
  Loop
 
Exit_Aufw:
  FilternAufw = Ret
  Exit Function
 
Err_Aufw:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_Aufw
End Function

' ============================ FilternAbw =================================
'   Die Prozedur FilternAbw erzeugt mit den Elementen aus [vArray] von
'   1 bis MaxEbene erneut einen "Heap" (siehe das Diagramm in der Prozedur
'   HeapSort).
' ============================================================================
'
Private Function FilternAbw(ByVal MaxEbene As Long, ByRef vArray As Variant) As Long
  Dim I        As Long
  Dim Kind     As Long
  Dim Ret      As Long
 
  ' Fehlerroutine
  On Error GoTo Err_Abw
 
  I = 1
 
  ' Bewege den Wert in vArray(x,1) im Heap solange nach unten, bis
  ' dieser seinen richtigen Knoten erreicht hat (das heißt, bis der Wert
  ' kleiner als sein Eltern-Knoten ist, oder bis er MaxEbene, die unterste
  ' Ebene des aktuellen Heaps, erreicht hat):
  Do
    Kind = 2 * I        ' Ermittle den Index für den Kind-Knoten.
 
    ' Verlasse die Prozedur, wenn unterste Ebene des Heaps erreicht ist:
    If Kind > MaxEbene Then Exit Do
 
    ' Falls es zwei Kind-Knoten gibt, finde heraus, welcher der größere ist:
    If Kind + 1 <= MaxEbene Then
      If vArray(Kind + 1, 1) > vArray(Kind, 1) Then
        Kind = Kind + 1
      End If
    End If
 
    ' Bewege den Wert nach unten, solange er noch nicht größer als
    ' irgendeines seiner Kinder ist:
    If vArray(I, 1) < vArray(Kind, 1) Then
      XSwap vArray(I, 0), vArray(Kind, 0)
      XSwap vArray(I, 1), vArray(Kind, 1)
      I = Kind
 
    ' Andernfalls ist [vArray] erneut als Heap von 1 bis MaxEbene
    ' aufgebaut, also beende:
    Else
      Exit Do
    End If
  Loop
 
Exit_Abw:
  FilternAbw = Ret
  Exit Function
 
Err_Abw:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_Abw
End Function

QuickSort
Der "QuickSort"-Algorithmus funktioniert, indem er ein zufälliges "Pivot"-Element aus [vArray] herausnimmt, anschließend jedes Element, das größer ist, auf eine Seite des Pivot-Elementes bewegt, und jedes Element, das kleiner ist, auf die andere Seite bewegt. QuickSort wird dann mit den beiden Unterabteilungen, die von dem Pivot-Element erzeugt wurden, rekursiv aufgerufen. Nachdem die Anzahl der Elemente in einer Unterabteilung einmal zwei erreicht hat, enden die rekursiven Aufrufe, und das Datenfeld ist sortiert.

Function QuickSort(ByRef vArray() As Variant, _
  Optional ByVal Klein As Long, Optional ByVal Gross As Long) As Long
 
  Dim I       As Long
  Dim J       As Long
  Dim K       As Long
  Dim L       As Long
  Dim Ret     As Long
  Dim UB      As Long
  Dim ZI      As Long
  Dim TS      As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_QS
 
  If Klein = 0 Then Klein = LBound(vArray)
  If Gross = 0 Then Gross = UBound(vArray)
 
  If Klein < Gross Then
 
    ' Nur zwei Elemente in dieser Unterabteilung; vertausche diese, wenn
    ' sie nicht in der richtigen Reihenfolge vorliegen und beende
    ' anschließend die rekursiven Aufrufe:
 
    If Gross - Klein = 1 Then
      If vArray(Klein, 1) > vArray(Gross, 1) Then
        XSwap vArray(Klein, 0), vArray(Gross, 0)
        XSwap vArray(Klein, 1), vArray(Gross, 1)
      End If
 
    Else
 
      ' Nimm ein zufälliges Pivot-Element heraus, bewege dieses dann an
      ' das Ende:
      ZI = ZufInt(Klein, Gross)
      XSwap vArray(Gross, 0), vArray(ZI, 0)
      XSwap vArray(Gross, 1), vArray(ZI, 1)
      TS = vArray(Gross, 1)
 
      Do
        ' Hinbewegung von beiden Seiten auf das Pivot-Element zu:
        I = Klein
        J = Gross
        Do While (vArray(I, 1) <= TS)
          I = I + 1
          If (I > J) Then
            I = I - 1
            Exit Do
          End If
        Loop
        Do While (vArray(J, 1) >= TS)
          J = J - 1
          If (J < I) Then
            J = J + 1
            Exit Do
          End If
        Loop
 
        ' Wird das Pivot-Element nicht erreicht, bedeutet dies, daß
        ' zwei Elemente auf einer Seite nicht in der richtigen Reihenfolge
        ' vorliegen, also vertausche diese Elemente:
        If I < J Then
          XSwap vArray(I, 0), vArray(J, 0)
          XSwap vArray(I, 1), vArray(J, 1)
        End If
      Loop While I < J
 
      ' Bewege das Pivot-Element zurück auf seinen richtigen Platz in
      ' dem Datenfeld:
      XSwap vArray(I, 0), vArray(Gross, 0)
      XSwap vArray(I, 1), vArray(Gross, 1)
 
 
      ' Rufe die Prozedur QuickSort rekursiv auf (übergib die kleinere
      ' Unterabteilung zuerst, um weniger Stapelplatz zu verwenden):
 
      If (I - Klein) < (Gross - I) Then
        QuickSort vArray, Klein, I - 1
        QuickSort vArray, I + 1, Gross
      Else
        QuickSort vArray, I + 1, Gross
        QuickSort vArray, Klein, I - 1
      End If
    End If
  End If
 
Exit_QS:
  QuickSort = Ret
  Exit Function
 
Err_QS:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_QS
End Function

Private Function ZufInt(ByVal Untere As Integer, ByVal Obere As Integer) As Integer
  Dim A       As Integer
 
  ' Fehlerroutine
  On Error GoTo Err_Zuf
 
  A = Int(Rnd * (Obere - Untere + 1)) + Untere
  If A <= 0 Then
    ' A = 1
  End If
  ZufInt = A
 
Exit_Zuf:
  Exit Function
 
Err_Zuf:
  Err.Clear
  Resume Exit_Zuf
End Function

AustauschSort
Der Algorithmus "Sortieren durch Austauschen" vergleicht jedes Element in [vArray] - beginnend mit dem ersten Element - mit jedem folgenden Element. Wenn eines der nachfolgenden Elemente kleiner ist als das aktuelle Element, wird es mit dem aktuellen Element getauscht, und der Ablauf wird mit dem nächsten Element in [vArray] wiederholt.

Function AusTauschSort(ByRef vArray() As Variant) As Long
  Dim I       As Long
  Dim J       As Long
  Dim K       As Long
  Dim L       As Long
  Dim Min     As Long
  Dim Max     As Long
  Dim Ret     As Long
  Dim UB      As Long
 
  ' Fehlerroutine
  On Error GoTo Err_ATS
 
  UB = UBound(vArray)
  Max = UB
 
  For I = 1 To Max
    Min = I
    For J = I + 1 To Max
      If vArray(J, 1) < vArray(Min, 1) Then
        Min = J
      End If
    Next J
 
    ' Es ist eine Zeile gefunden, die kleiner als die aktuelle Zeile
    ' ist, also vertausche diese beiden Datenfeldelemente:
 
    If Min > I Then
      XSwap vArray(I, 0), vArray(Min, 0)
      XSwap vArray(I, 1), vArray(Min, 1)
    End If
  Next I
 
Exit_ATS:
  AusTauschSort = Ret
  Exit Function
 
Err_ATS:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_ATS
End Function

AustauschSort_1
Diese Funktion ist doppelt zu schnell wie AutauschSort.

Function AusTauschSort_1(ByRef vArray() As Variant) As Long
  Dim I       As Long
  Dim J       As Long
  Dim K       As Long
  Dim L       As Long
  Dim Min     As Long
  Dim Max     As Long
  Dim Ret     As Long
  Dim UB      As Long
  Dim min0    As Variant
  Dim min1    As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_ATS
 
  UB = UBound(vArray)
  Max = UB
 
  For I = 1 To Max
    Min = I
    For J = Max To (I + 1) Step -1          ' absteigende Schleife
      If vArray(J, 1) < vArray(Min, 1) Then
        Min = J
        Exit For                            ' wenn 1.Element gefunden
      End If                                ' Exit Schleife
    Next J
 
    ' Es ist eine Zeile gefunden, die kleiner als die aktuelle Zeile
    ' ist, also vertausche diese beiden Datenfeldelemente:
 
    If Min > I Then
      ' XSwap vArray(I, 0), vArray(Min, 0)
      ' XSwap vArray(I, 1), vArray(Min, 1)
      min0 = vArray(Min, 0)        ' Formulierung ist
      min1 = vArray(Min, 1)        ' schneller als XSWAP
      vArray(Min, 0) = vArray(I, 0)
      vArray(Min, 1) = vArray(I, 1)
      vArray(I, 0) = min0
      vArray(I, 1) = min1
    End If
  Next I
 
Exit_ATS:
  AusTauschSort_1 = Ret
  Exit Function
 
Err_ATS:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_ATS
End Function

VB_SortData
Um große Datenmengen zu sortieren, z.B. aus Dateien, Tabellen, usw., wird der zu sortierende Begriff(Element o. Spaltenwert) mit seiner Position(Stellung) in einem 2-dimensionalen varArray an diese Funktion übergeben. Die Funktion sortiert den Begriff(vArray(X,1) und gibt quasi die Position(vArray(X,0) zurück.

' Algorithmus: abgewandeltes Austauschverfahren
'            : sortiert aufsteigend (>)
'
Function VB_SortData(ByRef vArray() As Variant) As Long
  Dim A       As Variant
  Dim B       As Variant
  Dim C       As Long
  Dim I       As Long
  Dim J       As Long
  Dim K       As Long
  Dim L       As Long
  Dim Ret     As Long
  Dim UB      As Long
  Dim Z       As Long
  Dim Min     As Long
  Dim min0    As Variant
  Dim min1    As Variant
  Dim LX()    As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_SD
 
  UB = UBound(vArray)
  L = UB
 
  ReDim LX(1 To L, 1)            ' dimensionieren, temp.Array
  For I = 1 To L                 ' einlesen
    LX(I, 0) = vArray(I, 0)      ' Position, SatzNr
    LX(I, 1) = vArray(I, 1)      ' zu sort.Begriff
  Next I
 
  ' #Sort
  For I = 1 To L
    Min = I
    A = LX(I, 1)        ' zu sort.Begriff
    For J = L To (I + 1) Step -1
      B = LX(J, 1)
      ' tausche wenn B < A
      If B < A Then
        Min = J
        Exit For        ' nur bei absteigender Schleife
      End If
    Next J
    If Min > I Then
      min0 = LX(Min, 0)
      min1 = LX(Min, 1)
      LX(Min, 0) = LX(I, 0)
      LX(Min, 1) = LX(I, 1)
      LX(I, 0) = min0
      LX(I, 1) = min1
    End If
  Next I
 
  For I = 1 To L                  ' rückschreiben
    vArray(I, 0) = LX(I, 0)
    vArray(I, 1) = LX(I, 1)
  Next I
 
  ' #Sort
 
Exit_SD:
  Erase LX
  VB_SortData = Ret
  Exit Function
 
Err_SD:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_SD
End Function

EinfügeSort
Die Prozedur EinfuegeSort vergleicht nacheinander den Wert jedes Elementes in [vArray] mit den Werten aller vorhergehenden Elemente. Nachdem die Prozedur die entsprechende Position für das neue Element gefunden hat, fügt es das Element an seinem neuen Platz ein und bewegt alle anderen Elemente um eine Position nach unten.

Function EinfuegeSort(ByRef vArray() As Variant) As Long
  Dim I       As Long
  Dim J       As Long
  Dim U       As Long
  Dim Ret     As Long
  Dim V0      As Variant
  Dim V1      As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_Einf
 
  U = UBound(vArray)
  For I = 2 To U
    ' ursprüngliche Werte speichern
    V0 = vArray(I, 0)
    V1 = vArray(I, 1)
    For J = I To 2 Step -1
      ' Solange die Länge des J-1sten Elementes größer als die Länge des
      ' ursprünglichen Elementes in vArray(I,1) ist, fahre fort,
      ' die Datenfeldelemente nach unten zu verschieben:
      If vArray(J - 1, 1) > V1 Then
        vArray(J, 0) = vArray(J - 1, 0)
        vArray(J, 1) = vArray(J - 1, 1)
 
      ' Andernfalls beende die FOR...NEXT-Schleife:
      Else
        Exit For
      End If
    Next J
 
    ' Füge den ursprünglichen Wert von vArray(i,0), vArray(i,1) in
    vArray(J, 0) = V0
    vArray(J, 1) = V1
  Next I
 
Exit_Einf:
  EinfuegeSort = Ret
  Exit Function
 
Err_Einf:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_Einf
End Function

BubbleSort
Der "BubbleSort"-Algorithmus durchläuft [vArray], vergleicht aufeinanderfolgende Elemente und vertauscht Paare, die nicht in der richtigen Reihenfolge vorliegen. Er fährt damit fort, bis keine Paare mehr getauscht wurden.

Function BubbleSort(ByRef vArray() As Variant) As Long
  Dim I           As Long
  Dim L           As Long
  Dim UB          As Long
  Dim Limit       As Long
  Dim MaxZeile    As Long
  Dim OffSet      As Long
  Dim Tauschen    As Long
  Dim Ret         As Long
  Dim Min         As Long
  Dim min0        As Variant
  Dim min1        As Variant
  Dim LX()        As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_Bubble
 
  UB = UBound(vArray)
  L = UB
 
  ReDim LX(1 To L, 1)         ' dimensionieren, temp.Array
  For I = 1 To L              'einlesen
    LX(I, 0) = vArray(I, 0)   ' Position, SatzNr
    LX(I, 1) = vArray(I, 1)   ' zu sort.Begriff
  Next I
 
  MaxZeile = L
  Limit = MaxZeile
  Do
    Tauschen = 0
    For I = 1 To (Limit - 1)
 
      ' Zwei aufeinanderfolgende Elemente liegen nicht in der 
      ' richtigen Reihenfolge vor, also tausche deren Werte.
      Min = I + 1
      If LX(I, 1) > LX(Min, 1) Then
        min0 = LX(Min, 0)
        min1 = LX(Min, 1)
        LX(Min, 0) = LX(I, 0)
        LX(Min, 1) = LX(I, 1)
        LX(I, 0) = min0
        LX(I, 1) = min1
        Tauschen = I
      End If
    Next I
 
    ' Sortiere im nächsten Schritt nur bis dahin, wo der 
    ' letzte Tausch vorgenommen wurde:
    Limit = Tauschen
  Loop While Tauschen
 
  For I = 1 To L              ' rückschreiben
    vArray(I, 0) = LX(I, 0)
    vArray(I, 1) = LX(I, 1)
  Next I
 
Exit_Bubble:
  Erase LX
  BubbleSort = Ret
  Exit Function
 
Err_Bubble:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_Bubble
End Function

VB_QuickSort

Function VB_QuickSort(ByRef vArray() As Variant, _
  Optional ByVal LB As Long, Optional ByVal UB As Long)
 
  Dim P1      As Long
  Dim P2      As Long
  Dim PQ      As Long
  Dim Ret     As Long
  Dim TS      As Variant
  Dim vTmp0   As Variant
  Dim vTmp1   As Variant
 
  ' Fehlerroutine
  On Error GoTo Err_VB_Quick
 
  If LB = 0 Then LB = LBound(vArray)
  If UB = 0 Then UB = UBound(vArray)
 
  P1 = LB
  P2 = UB
  PQ = (P1 + P2) \ 2
 
  TS = vArray(PQ, 1)
 
  Do
    Do While (vArray(P1, 1) < TS)
      P1 = P1 + 1
    Loop
 
    Do While (vArray(P2, 1) > TS)
      P2 = P2 - 1
    Loop
 
    If P1 <= P2 Then
      vTmp0 = vArray(P1, 0)
      vTmp1 = vArray(P1, 1)
      vArray(P1, 0) = vArray(P2, 0)
      vArray(P1, 1) = vArray(P2, 1)
      vArray(P2, 0) = vTmp0
      vArray(P2, 1) = vTmp1
 
      P1 = P1 + 1
      P2 = P2 - 1
    End If
  Loop Until (P1 > P2)
 
  ' Rufe die Prozedur VB_QuickSort rekursiv auf
  If LB < P2 Then
    VB_QuickSort vArray, LB, P2
  End If
  If P1 < UB Then
    VB_QuickSort vArray, P1, UB
  End If
 
Exit_VB_Quick:
  VB_QuickSort = Ret
  Exit Function
 
Err_VB_Quick:
  With Err
    Ret = .Number
    .Clear
  End With
  Resume Exit_VB_Quick
End Function