QuickSort gehört zu einem der schnellsten Sortier-Algorithmen. Den dazugehörigen VB-Code haben wir Ihnen ja schon vor einiger Zeit vorgestellt: Damit der QuickSort-Algorithmus universell eingesetzt werden konnte, wurde das zu sortierende Array als Variant-Parameter deklariert. Durch gezielte Datentyp-Deklaration lässt sich das Sortierverfahren aber erheblich steigern. Bei großen Datenmengen sollte man deshalb mehrere QuickSort-Varianten verwenden, z.B. QuickSort_s für String-Arrays, QuickSort_l für LongInteger-Arrays usw. Handelt es sich beim zu sortierenden Array um ein String-Array lässt sich die Perfomance nochmals steigern, wenn man das Vertauschen zweier Array-Inhalte durch eine API-Funktion erledigt. Nachfolgend der optimierte QuickSort-Algorithmus für String-Arrays. ' Benötigte API-Deklaration Private Declare Sub CopyMemoryPtr Lib "kernel32" _ Alias "RtlMoveMemory" ( _ ByVal DestPtr As Long, _ ByVal SourcePtr As Long, _ ByVal Bytes As Long) Public Sub QuickSort_s(ByRef vSort() As String, _ Optional ByVal lngStart As Variant, _ Optional ByVal lngEnd As Variant) ' Wird die Bereichsgrenze nicht angegeben, ' so wird das gesamte Array sortiert If IsMissing(lngStart) Then lngStart = LBound(vSort) If IsMissing(lngEnd) Then lngEnd = UBound(vSort) Dim i As Long Dim j As Long Dim X As String Dim n As Long Dim nPtr As Long On Error Resume Next i = lngStart: j = lngEnd n = ((lngStart + lngEnd) \ 2) X = vSort(n) ' Array aufteilen Do Do While (StrComp(vSort(i), X, vbTextCompare) = -1): i = i + 1: Loop Do While (StrComp(vSort(j), X, vbTextCompare) = 1): j = j - 1: Loop If (i <= j) Then ' Wertepaare miteinander tauschen nPtr = StrPtr(vSort(i)) CopyMemoryPtr VarPtr(vSort(i)), VarPtr(vSort(j)), Len(nPtr) CopyMemoryPtr VarPtr(vSort(j)), VarPtr(nPtr), Len(nPtr) i = i + 1: j = j - 1 End If Loop Until (i > j) ' Rekursion (Funktion ruft sich selbst auf) If (lngStart < j) Then QuickSort_s vSort, lngStart, j If (i < lngEnd) Then QuickSort_s vSort, i, lngEnd On Error GoTo 0 End Sub Im Gegensatz zum Standard-QuickSort-Algorithmus wird die Groß-/Kleinschreibung hier korrekt berücksichtigt, d.h. Strings mit kleinen Anfangs-Buchstaben reihen sich korrekt ein. Ein kleiner Geschwindigkeitstest Option Explicit Private Const nCount = 49999 Dim sArray() As String Private Sub Form_Load() ' Array mit 50000 Elementen Dim i As Long Dim n As Long Dim u As Long Dim b As Long ReDim sArray(nCount) Randomize -Timer For i = 0 To nCount ' zufällige Wortlänge n = Int(20 * Rnd + 5) For u = 1 To n ' zufällige Buchstabenkombination b = Int(2 * Rnd + 1) If b = 1 Then sArray(i) = sArray(i) & Chr$(64 + Int(26 * Rnd + 1)) Else sArray(i) = sArray(i) & Chr$(96 + Int(26 * Rnd + 1)) End If Next u Next i End Sub Private Sub Command1_Click() Dim nStart As Single Dim sTemp() As String Dim i As Long Screen.MousePointer = vbHourglass ' Temporäres Array ReDim sTemp(nCount) For i = 0 To nCount sTemp(i) = sArray(i) Next i ' Zeit nehmen nStart = Timer ' Array sortieren: "altes Verfahren" QuickSort sTemp, 0, nCount ' Benötigte Zeit Label1.Caption = "Zeit: " & CStr(Timer - nStart) & " Sek." ' Array in Liste ausgeben List1.Clear List1.Visible = False DoEvents For i = 0 To nCount List1.AddItem sTemp(i) Next i List1.Visible = True Screen.MousePointer = vbNormal End Sub Private Sub Command2_Click() Dim nStart As Single Dim sTemp() As String Dim i As Long Screen.MousePointer = vbHourglass ' Temporäres Array ReDim sTemp(nCount) For i = 0 To nCount sTemp(i) = sArray(i) Next i ' Zeit nehmen nStart = Timer ' Array sortieren: optimierte Variante QuickSort_s sTemp, 0, nCount ' Benötigte Zeit Label2.Caption = "Zeit: " & CStr(Timer - nStart) & " Sek." ' Array in Liste ausgeben List2.Clear List2.Visible = False DoEvents For i = 0 To nCount List2.AddItem sTemp(i) Next i List2.Visible = True Screen.MousePointer = vbNormal End Sub Das Ergebnis: Dieser Tipp wurde bereits 20.495 mal aufgerufen. Voriger Tipp | Zufälliger Tipp | Nächster Tipp
Anzeige
Diesen und auch alle anderen Tipps & Tricks finden Sie auch auf unserer aktuellen vb@rchiv Vol.6 (einschl. Beispielprojekt!) Ein absolutes Muss - Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! - nahezu alle Tipps & Tricks und Workshops mit Beispielprojekten - Symbol-Galerie mit mehr als 3.200 Icons im modernen Look Weitere Infos - 4 Entwickler-Vollversionen (u.a. sevFTP für .NET), Online-Update-Funktion u.v.m. |
vb@rchiv CD Vol.6 Geballtes Wissen aus mehr als 8 Jahren vb@rchiv! Online-Update-Funktion Entwickler-Vollversionen u.v.m. Tipp des Monats Mai 2024 Hermann Röttger Wochentage eines Datumsbereichs ermitteln Wochentage eines Datumsbereichs ermitteln, optional mit Feiertagsberechnung Neu! sevDTA 3.0 Pro SEPA mit Kontonummernprüfung Erstellen von SEPA-Dateien mit integriertem BIC-Verzeichnis und Konto- nummern-Prüfverfahren, so dass ungültige Bankdaten bereits im Vorfeld ermittelt werden können. |
||||||||||||||||
Microsoft, Windows und Visual Basic sind entweder eingetragene Marken oder Marken der Microsoft Corporation in den USA und/oder anderen Ländern. Weitere auf dieser Homepage aufgeführten Produkt- und Firmennamen können geschützte Marken ihrer jeweiligen Inhaber sein. |