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.425 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. |
Neu! sevPopUp 2.0 Dynamische Kontextmenüs! Erstellen Sie mit nur wenigen Zeilen Code Kontextmenüs dynamisch zur Laufzeit. Vordefinierte Styles (XP, Office, OfficeXP, Vista oder Windows 8) erleichtern die Anpassung an die eigenen Anwendung... Tipp des Monats April 2024 Skyfloy Chart von Microsoft und dazu noch gratis Tutorial für Microsoft Chart Controls für Microsoft .NET Framework 3.5 TOP Entwickler-Paket TOP-Preis!! Mit der Developer CD erhalten Sie insgesamt 24 Entwickler- komponenten und Windows-DLLs. Die Einzelkomponenten haben einen Gesamtwert von 1605.50 EUR... |
||||||||||||||||
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. |