Quicksort

Tobias Schmid - my VBA 

Daten sortieren mit VBA

Wie sortiert man Datenfelder bzw. Vektoren in VBA? In Excel gibt es vielfältige Lösungen (Daten sortieren, KGROESSTE und sicher viele mehr), aber wie könnte man Datenfelder direkt in VBA sortieren?

In diesem Artikel möchte ich aber nicht nur den Sortieralgorithmus Quicksort für VBA implementieren. Quicksort ist auch ein hervorragendes Beispiel für einen rekursiven Funktionsaufruf. Und zu Letzt werden wir sehen welche Vorteile das „Chaos“ eines völlig ungeordneten Datenfeldes für die Laufzeit des Algorithmus hat.

Quicksort für VBA

Wer noch nicht weiß wie der Quicksort-Algorithmus funktioniert, dem empfehle ich unter anderen den Artikel zu Quicksort auf Wikipedia zu lesen, sowie die weiterführenden Links zu lesen. Hier ist meine Implementierung von Quicksort für VBA.

Option Explicit
Option Base 1

'---------------------------------------------------------------------------------------
' Module : Quicksort_mit_Counter
' DateTime : 31.07.2008
' Author : Tobias - tobiasschmid.de
' Purpose : einfacher Quicksort-Algorithmus
'---------------------------------------------------------------------------------------

Private Daten() As Double'Datenfeld für den zu sortierenden Vektor
Private rng As Range 'Ein- und Ausgabezellbereich

Sub Main()
'Daten aus den Zellen A1 bis Axx in das Datenfeld Daten kopieren
Set rng = Range("A1:A1000")
DatenEinlesen

'Daten mit Quicksort sortieren
'Der "erste" Quicksort wird mit maximaler Länge gestartet
Call Quicksort(von:=1, bis:=UBound(Daten))

'Daten wieder ins Excel-Sheet zurückschreiben
'Ausgabe der sortierten Liste soll in Nachbarspalte erfolgen
Set rng = rng.Offset(, 1)
DatenSchreiben

'Kurze Meldung wenn fertig
Debug.Print "fertig"
End Sub

Private Sub DatenEinlesen()
Dim i As Long
ReDim Daten(rng.Rows.Count)

'Zelleninhalte schnell nach VBA lesen
For i = 1 To UBound(Daten)
Daten(i) = rng(i, 1)
Next
End Sub

Private Sub DatenSchreiben()
Dim i As Long
Dim var As Variant

'VBA-Daten schnell in Zellen schreiben
var = rng
For i = 1 To UBound(Daten)
var(i, 1) = Daten(i)
Next
rng = var
End Sub

Private Function Quicksort(von As Long, bis As Long)
Dim Teiler As Long
If bis > von Then
Teiler = Teile(von:=von, bis:=bis)
Call Quicksort(von:=von, bis:=Teiler - 1)
Call Quicksort(von:=Teiler + 1, bis:=bis)
End If
End Function

Private Function Teile(von As Long, bis As Long)
Dim Index As Long
Dim i As Long
Index = von

For i = von To bis - 1
If Daten(i) <= Daten(bis) Then
Call Tausche(Index, i)
Index = Index + 1
End If
Next
Call Tausche(Index, bis)
Teile = Index
End Function

Private Sub Tausche(i As Long, j As Long)
Dim Temp As Double

'Tausche Daten(i) mit Daten(j)
Temp = Daten(i)
Daten(i) = Daten(j)
Daten(j) = Temp
End Sub

Die zu sortierenden Daten werden hierbei aus dem Bereich A1:A1000 des aktuellen Tabellenblatts eingelesen. Zu Testzwecken habe ich in die Spalte A die Zahlen 1 bis 65536 in absteigender Reihenfolge eingefügt. Wer den Wikipediaartikel genau gelesen hat, erinnert sich, dass dies den „worst-case“ für Quicksort darstellt. Bei dieser Sortierung der Liste finden besonders viele rekursive Funktionsaufrufe statt und die Rechenzeit wird maximal.

Warum ist der Fall der absteigend sortierten Liste so wichtig zu beachten?

Klar, wegen den Funktionsaufrufen. Aber ist es nicht sehr unwahrscheinlich, das die zu sortierende Liste genau „falsch“ herum sortiert ist? Nein! Das ist sogar sehr wahrscheinlich.

Ein bisschen gefühlte (!) Stochastik, Mathematiker bitte weg hören:

Welche Möglichkeiten gibt es für die Sortierung einer Liste? Antwort (sicher nicht n!) sondern 3. Begründung:

  1. unsortiert

  2. Aufsteigend

  3. Absteigend

Und die gefühlte Wahrheit ist leider, das jeder Fall gleich wahrscheinlich ist, also 33 %. Somit ist die Wahrscheinlichkeit für eine absteigend sortierte Liste auch 33 %.

Wem das seltsam vorkommt, hier noch ein Beispiel:

Am Samstag spiele ich Lotto. Was kann passieren?

  1. Ich gewinne und bin Millionär

  2. Ich verliere

Ist doch super. 50 % auf Sieg und ab ins Lottogeschäft! ;-)

Wieviele rekursive Funktionsaufrufe sind es denn?

Durch Einbau eines Counters, einer Variable die die Anzahl von Funktionsaufrufen speichert, kann festgestellt werden wie viele Funktionen „gleichzeitig“ im Speicher liegen. Mit dem Counter ausgerüstet stellt sich sofort die Frage, wie viele Funktionsaufrufe maximal möglich sind.

Am Beispiel unserer absteigend sortierten Liste ergibt sich folgendes Ergebnis: Bei einer Vektorlänge von 5002 Elementen und 5003 Funktionsaufrufen bricht der Algorithmus ab. Absteigend sortierte Liste mit mehr als 5001 Elemente (einer absteigend sortierten Liste!) können mit VBA nicht sortiert werden. Spürbar ist auch, dass der Algorithmus deutlich langsamer wird (nicht sortierte Listen sind deutlich schneller, dazu gleich mehr!).

Schneller und gleichzeitig auch größere Datenfelder sortieren? Optimierung des Codes!

Auch hier möchte ich auf Wikipedia verweisen, wo ein Mischen des Datenvekors zur Erhöhung der Geschwindigkeit und Verringerung der Funktionsaufrufe vorgeschlagen wird.

Hier meine Randomize-Funktion um den Vektor zu mischen:

Private Sub RandomizeDaten()
Dim iOld As Long, iNew As Long
Dim Count As Long
Count = UBound(Daten)

For iOld = 1 To Count
    iNew = Rnd * (Count - 1) + 1
    Call Tausche(iNew, iOld)
Next
End Sub

Und wie ich sie in die Hauptfunktion eingebaut habe:

Sub Main()
'Daten aus den Zellen AA22 bis AA8780 in das Datenfeld Daten kopieren
    Set rng = Range("A1:A65536")
    DatenEinlesen

    'Daten mischen
    Call RandomizeDaten

    'Daten mit Quicksort sortieren
    'Der "erste" Quicksort wird mit maximaler Länge gestartet
    Counter = 1
    Call Quicksort(von:=1, bis:=UBound(Daten))

    'Daten wieder ins Excel-Sheet zurückschreiben
    'Ausgabe der sortierten Liste soll in Nachbarspalte erfolgen
    Set rng = rng.Offset(, 1)
    DatenSchreiben

    'Kurze Meldung wenn fertig
    Debug.Print "fertig", maxCounter
End Sub

Wow! Das fühlt sich doch gleich anders an. Deutlich schneller. Und wer ein bisschen herum probiert, stellt auch fest, dass auch längere Listen kein Problem mehr sind. Wie groß der Geschwindigkeitsvorteil ist? In den folgenden Diagramm habe ich den Quicksort-Algorithmus mit und ohne Randomize auf unser absteigend sortiertes Datenfeld losgelassen.

Sowohl die benötigte Rechenzeit, wie auch die Anzahl von Funktionsaufrufen ist drastisch gesunken. Und wie viel Zeit verbraucht unser Algorithmus für das Mischen mit Randomize, siehe hier:


Alles Gut oder was? Die Grenzen des Algorithmus

Datenfelder mit einer Länge von 36.000.000 sortiert Quicksort mit ca 70 rekursiven Funktionsaufruf in ca. 5 Minuten. Größere Datenfelder bringen ganz neue Probleme mit sich, dazu vielleicht ein anderes Mal.