Home > Artikel > Ausgabe 2/2017 > Sortieralgorithmen

Sortieralgorithmen

Achtung: Sie sind nicht angemeldet. Wenn Sie Abonnent sind und sich anmelden, lesen Sie den kompletten Artikel, laden das PDF herunter oder probieren die Beispieldatenbank aus (sofern vorhanden).

In Datenbanken muss man sich über die Sortierung von Datensätzen gemeinhin keine Gedanken machen. Die Engines enthalten alles Benötigte, um Daten in Abfragen oder auch Recordsets über einfache SQL-Statements sortiert auszugeben. Doch hin und wieder steht man vor der Aufgabe, auch Daten in Arrays zu sortieren, etwa, um sie einem Treeview oder einem Listenfeld zu verabreichen. Über die möglichen Algorithmen erfahren Sie hier mehr.

Beispieldatenbank

Die Beispiele dieses Artikels finden Sie in der Datenbank 1702_Sorting.zip.

Sortieren per VBA

Einen kleinen Vorgeschmack lieferte bereits der Beitrag zu BubbleSort der Doppelausgabe 01/2016. Dieser Algorithmus ist ziemlich simpel und durchschaubar. Er hat aber seine Grenzen erreicht, sobald es um die Performance geht. Bei umfangreichen Datenbeständen ist er extrem langsam. Hier sind Alternativen gefragt.

Eigentlich kommt es ziemlich selten vor, dass Daten per VBA sortiert werden müssen. Sie liegen ja in der Regel in Tabellen vor, und die lassen sich über Abfragen sortieren. Manchmal jedoch kommen sie aus externen Quellen, wie etwa Textdateien. Natürlich könnte man diese in Tabellen importieren, dann einer Sortierabfrage unterziehen und das Ergebnis, so benötigt, wieder im VBA-Projekt über ein Recordset auslesen. Eleganter ist es aber, diesem Umweg zu vermeiden und die Daten direkt per VBA zu sortieren. Legen Sie sich dazu einfach ein Modul mit generellen Sortieralgorithmen an, wie in der Beispieldatenbank geschehen, das Sie später gegebenenfalls in ihre Zieldatenbank kopieren können.

Ausgangslage: String-Array

Der häufigste Fall ist sicher das Sortieren von Texten eines String-Arrays. Um diesen Anwendungsfall mit den im Folgenden vorgestellten Algorithmen zu testen, wird ein gefülltes String-Array mit einer nicht zu geringen Anzahl von Einträgen benötigt. Wir holen sie einfach aus einer vorliegenden Kundentabelle. Die Hilfsfunktion CreateStringArray (siehe Listing 1) stellt es zur Verfügung.

Private Function CreateStringArray(Optional Limit As Long) As String()

     Dim rs As DAO.Recordset

     Dim S As String

     Dim n As Long

     Dim arrRet() As String

     Set rs = CurrentDb.OpenRecordset("SELECT Nachname, Vorname" & _

         "FROM tblKunden ORDER By ID", dbOpenDynaset)

     Do While Not rs.EOF

         If (Len(rs!Nachname.Value) > 2) And _

            (Len(rs!Vorname.Value) > 2) Then

             S = rs!Nachname.Value & ", " & rs!Vorname.Value

             ReDim Preserve arrRet(n)

             arrRet(n) = S

             n = n + 1

         End If

         If Limit <> 0 Then If n > Limit Then Exit Do

         rs.MoveNext

     Loop

     rs.Close

     CreateStringArray = arrRet

End Function

Listing 1: Über diese Funktion werden die Daten einer Kundentabelle in ein String-Array überführt

Hier werden die Felder Nachname und Vorname der Tabelle tblKunden in ein Recordset aufgenommen, das nach der ID der Datensätze sortiert ist. Die Namen selbst sind damit unsortiert. Eine Schleife durchläuft alle Datensätze und berücksichtigt nur jene, in der die Namen mindestens drei Buchstaben enthalten. In der Variablen S werden dann Nachname und Vorname, durch Komma getrennt, aneinandergefügt. Dieses Ergebnis wird jeweils einem Element des Arrays arrRet zugewiesen, dessen Dimension sich ständig über die Zählvariable n erweitert, wobei die ReDim-Anweisung den Inhalt nicht zerstört, weil sie eine Preserve-Klausel enthält. Optional können Sie der Prozedur per Parameter ein Limit übergeben, welches die Anzahl der Elemente des Ergebnis-Arrays begrenzt. Ohne Limit kommt es zu etwa 9.000 Elementen.

Sie rufen diese Funktion etwa so auf:

Dim arr() As String

arr = CreateStringArray()

... (Sortieren von arr() ) ...

Hier handelt es sich um ein eindimensionales Array. Nachname und Vorname stehen nicht in getrennten Feldern. Letzteres würde ein zweidimensionales Array erfordern und damit auch kompliziertere Sortieralgorithmen. Der Trick des Verkettens von Nach- und Vorname über ein Trennzeichen sortiert aber automatisch korrekt nach beiden Feldern, soweit zufällig nicht in einem Nachnamen ein Komma enthalten ist. Nun kann es an das Sortieren des Test-Arrays gehen.

Wizhook

Access-VBA hält an sich keine Funktion vor, um eine solches Array zu sortieren. Tatsächlich existiert jedoch eine Methode eines versteckten Klassenobjekts, die das ermöglicht. Blenden Sie im Objektkatalog per Kontextmenü die Verborgenen Elemente ein, so finden Sie die Klasse Wizhook in ihm, bei der es sich um eine Sammlung von Funktionen zu verschiedensten Aspekten handelt. Sie müssen kein Objekt dieser Klasse neu erzeugen, da Access sie von sich aus instanziiert. Der Beweis im VBA-Direktfenster:

  Wizhook Is Nothing

-> Falsch

Eine Methode der Klasse lautet SortStringArray mit dieser Definition:

Sub SortStringArray(Array() As String)

Zu übergeben ist ihr also ein String-Array, das allerdings eindimensional sein muss. Sie sortiert das Array auch wunschgemäß. Das aber erst, nachdem die Klasse freigegeben wurde! Denn ohne einen geheimen Schlüssel funktionieren keine der Funktionen des Wizhook-Objekts. Sie schalten sie erst über das Setzen der Key-Eigenschaft frei. Wozu Microsoft das implementiert hat, ist ein Rätsel, denn dieser Zahlenschlüssel ist natürlich keineswegs geheim:

Sub SortWizHook(sarr() As String)

     WizHook.Key = 51488399

     WizHook.SortStringArray sarr

End Sub

Die Methoden dieser Klasse wurden übrigens mit jeder neuen Access-Version erweitert. Sie sind nicht dokumentiert, und auch einige Seiten im Netz konnten nur einen Teil der Funktionen analysieren.

Der Key wird hier bei jedem Aufruf der Funktion SortWizHook gesetzt. Das ist allerdings nicht wirklich notwendig. Einmal gesetzt bleibt die Klasse für die gesamte VBA-Sitzung freigeschaltet. Die korrekte Funktion können Sie nun etwa so testen:

Dim arr() As String

Dim i As Long

arr = CreateStringArray()

SortWizHook arr

For i = 0 To Ubound(arr)

     Debug.Print arr(i)

Next i

Im VBA-Direktfenster listen sich nun alle Namen des Arrays alphanumerisch aufsteigend auf. Der Wizhook-Methode kann nicht angegeben werden, ob auf- oder absteigend sortiert werden soll. Das hat sie auch mit den meisten der folgenden Algorithmen gemein. Wäre eine absteigende Sortierung gewünscht, so müsste diese anschließend über ein erneutes Umsortierung mit einer Hilfsfunktion erreicht werden:

Sub SortReverse (arr() As String)

     Dim arrRet() As String

     Dim n As Long, i As Long

     

     n= UBound(arr)

     Redim arrRet(n)

     For i = 0 To n

         arrRet(i) = arr(n-i)

     Next i

End Sub

Das tut der Performance keinen Abbruch und verläuft ziemlich schnell.

BubbleSort

Der Vollständigkeit halber bilden wir den BubbleSort-Algorithmus nochmals in Listing 2 ab. Jedes Element des Arrays sarr wird ausnahmslos mit jedem verglichen. Ist das eine größer, als das andere, so kommt es zum Vertauschen der beiden über die temporäre Variable S. Eine absteigende Sortierung erhalten Sie hier durch Änderung der Vergleichszeile:

Sub BubbleSortStrings(sarr() As String)

     Dim S As String

     Dim i As Long, j As Long, n As Long

     

     n = UBound(sarr)

     For i = 0 To n - 1

         For j = i + 1 To n

             If sarr(i) > sarr(j) Then

                 S = sarr(i)

                 sarr(i) = sarr(j)

                 sarr(j) = S

             End If

         Next j

     Next i

End Sub

Listing 2: Funktion zum Sortieren über BubbleSort

If sarr(i) < sarr(j) Then

Bei den 9.000 Elementen des Beispiel-Arrays kommt es hier zu über 40 Millionen Iterationen. Das beansprucht auch auf einem aktuellen Rechner ziemlich viel Rechenzeit. Wir haben bei uns 13 Sekunden gemessen – ein völlig inakzeptabler Wert! Die Wizhook-Methode erreichte dasselbe Ergebnis in nur 0,03 Sekunden!

Sehen wir, ob sich dieser Wert durch andere Methoden noch unterbieten lässt.

QuickSort

Dieser Algorithmus ist zweifellos der verbreitetste überhaupt. Es ist davon auszugehen, dass auch die Wizhook-Methode, wie auch die Database Engine, ihn intern verwenden. Seine Effizienz ist kaum zu überbieten. Der Witz an ihm ist der Umstand, dass er ausgerechnet dann am schnellsten ist, wenn die Daten möglichst unsortiert daher kommen. Sind die Daten bereits weitgehend vorsortiert, dann ist er recht langsam!

Der Algorithmus in Listing 3 arbeitet rekursiv. Das heißt, dass sich die Funktion fortwährend selbst aufruft, wie an den letzten beiden Zeilen zu erkennen ist. Die jeweiligen Elementzeiger stehen in den Variablen LR und LL, stellvertretend für Rechter Zeiger und Linker Zeiger.

Public Sub QuickSortStrings(sarr() As String, Optional ByVal LL As Long, Optional ByVal LR As Long)

     Dim n1 As Long, n2 As Long

     Dim sTmp As String, sSwap As String

     If LR = 0 Then LL = LBound(sarr): LR = UBound(sarr)

     n1 = LL: n2 = LR

     sTmp = sarr((LL + LR) \ 2)

     Do

         Do While (sarr(n1) < sTmp) And (n1 < LR)

             n1 = n1 + 1

         Loop

         Do While (sTmp < sarr(n2)) And (n2 > LL)

             n2 = n2 - 1

         Loop

         If n1 <= n2 Then

             sSwap = sarr(n1)

             sarr(n1) = sarr(n2)

             sarr(n2) = sSwap

             n1 = n1 + 1

             n2 = n2 - 1

         End If

     Loop Until n1 > n2

     If LL < n2 Then QuickSortStrings sarr, LL, n2

     If n1 < LR Then QuickSortStrings sarr, n1, LR

End Sub

Listing 3: Funktion zum Sortieren über Quicksort

Das Prinzip besteht darin, dass die Daten zunehmend hälftig in Blöcke unterteilt und dann jeweils nur die Elemente eines Blocks untersucht werden. Und die Blöcke werden immer kleiner, bis sie nur noch aus zwei Elementen bestehen. Das schränkt die Anzahl der Vergleiche stark ein.

Sie übergeben der Funktion nur das Array und lassen die beiden optionalen Parameter unberücksichtigt:

Dim arr() As String

arr = CreateStringArray()

QuickSortStrings arr

Obwohl VBA nicht gerade die schnellste Programmiersprache der Welt ist, messen wir für das Beispiel eine Ausführungszeit von nur 0,039 Sekunden. Das kann schon mit der Wizhook-Methode konkurrieren! Doch wozu eine benutzerdefinierte Funktion einsetzen, wenn es schon eine eingebaute gibt?

Das Modul mdlSortStrings enthält eine Variante des Quicksort-Algorithmus (QuickSortVariants), dem Sie auch ein Variant-Array übergeben können. Sein Aufbau ist ansonsten identisch zu dem in Listing 2. Sie können der Routine also ein Array übergeben, das beliebige Datentypen enthält, wie etwa Zahlenwerte (Long) oder Datumswerte (Date).

Die Elemente müssen in der Deklaration des Arrays allerdings vom Typ Variant sein. Wie sich herausstellt, ist diese Alternative genauso schnell, wie die String-Variante. Und das ist ein Vorteil, weil die Wizhook-Methode nun mal nur Strings als Input akzeptiert.

Shellsort

Auch dieser Algorithmus gehört zu den performanteren. Eine Implementation in der Beispieldatenbank zeigt Listing 4. Das Verfahren ähnelt dem Quicksort-Algorithmus, weil er auch hier die Elemente des Arrays in Blöcke aufteilt, die den Vergleichsoperationen unterzogen werden. Er arbeitet aber nicht rekursiv, sondern verwendet stattdessen verschachtelte Schleifen. Sie können die Routine auch für Variants abändern, indem Sie die String-Angaben in Variant-Deklarationen umwandeln. Eigentlich würde man erwarten, dass VBA mit Variant-Datentypen langsamer ist, als mit diskreten Datentypen. Zumindest kann man derlei auf verschiedenen Seiten zur Performanceoptimierung lesen. Unsere Erfahrungen bestätigen dies nicht! Heutzutage sind die Windows-Bibliotheken, die für die interne Umwandlung von Variant-Typen angesprochen werden, dermaßen optimiert, dass der geringe Mehraufwand auf aktuellen Rechnern nicht mehr ins Gewicht fällt.

Public Sub ShellSortStrings(sarr() As String)

     Dim lHold As Long

     Dim lGap As Long

     Dim i As Long

     Dim iMin As Long

     Dim iMax As Long

     Dim sSwap As String

     iMin = LBound(sarr)

     iMax = UBound(sarr)

     lGap = iMin

     Do

         lGap = 3 * lGap + 1

     Loop Until lGap > iMax

     Do

         lGap = lGap \ 3

         For i = lGap + iMin To iMax

             sSwap = sarr(i)

             lHold = i

             Do While sarr(lHold - lGap) > sSwap

                 sarr(lHold) = sarr(lHold - lGap)

                 lHold = lHold - lGap

                 If lHold < iMin + lGap Then Exit Do

             Loop

             sarr(lHold) = sSwap

         Next i

     Loop Until lGap = 1

End Sub

Listing 4: Funktion zum Sortieren über Shellsort

Unser Test sieht nun so aus:

Dim arr() As String

arr = CreateStringArray()

ShellSortStrings arr

Wir kommen auf eine Ausführungszeit für Shellsort von 0,06 Sekunden. Auch das ist ein ordentlicher Wert, der allerdings gegenüber Quicksort abfällt. Das ändert sich indessen, wenn das Ausgangs-Array vorsortierte Daten enthält. Rufen Sie etwa die beiden Sortieralgorithmen jeweils direkt zweimal hintereinander auf, so hat Shellsort eindeutig die Nase vorn! Es kommt mit vorsortierten Daten besser zurecht und wäre immer dann einzusetzen, wenn von solchen Voraussetzungen ausgehen wäre.

Shakersort

Dieser etwas exotische Algorithmus (siehe Listing 5) treibt die Sache auf die Spitze. Eine Erläuterung der Funktionsweise fiele völlig aus dem Rahmen des Beitrags. Hier wird versucht, die Aufteilung in Blöcke mit einigen Tricks so effizient zu machen, wie möglich. Wir messen für seine Ausführung 0,09 Sekunden. Das ist deutlich langsamer, als Shellsort. Dem steht allerdings die Tatsache gegenüber, dass Shakersort sowohl mit unsortierten, wie auch vorsortierten Daten am besten zurechtkommt. Die geringere Performance kommt durch den großen Codeumfang und die zahlreichen Berechnungen zustande. Hier zeigt sich ein Nachteil von VBA.

Public Sub ShakerSortStrings(sarr() As String)

     Dim i As Long, j As Long, k As Long, iMin As Long, iMax As Long

     Dim sSwap As String, b As Boolean

     iMin = LBound(sarr): iMax = UBound(sarr)

     i = (iMax - iMin) * 1999 \ 2000 + iMin

     Do

         j = i: b = False

         Do While j > iMin

             For k = iMin To i - j

                 If sarr(k) > sarr(k + j) Then

                     sSwap = sarr(k): sarr(k) = sarr(k + j): sarr(k + j) = sSwap: b = True

                 End If

             Next

             If b Then

Sie haben das Ende des frei verfügbaren Teil dieses Artikels erreicht!

Wenn Sie mehr lesen und auf viele weitere Artikel zugreifen möchten, melden Sie sich als Abonnent unter Login an. Falls nicht, bestellen Sie doch einfach ein Jahresabonnement!