Kontakt
DSVGO
Dieser Algo sucht erst das Minimum und stellt es an die erste Stelle des Arrays. Dann sucht es (aus dem unsortierten Rest) das zweite Minimum und stellt es an die zweite Stelle, etc. pp.
Public Sub MinSortString(ByRef Strings() As String) MinSortStringBounds Strings, LBound(Strings), UBound(Strings) End Sub
' ©2004 by Jost Schwider, http://vb-tec.de/ Public Sub MinSortStringBounds(ByRef Strings() As String, _ ByVal MinBound As Long, ByVal MaxBound As Long) Dim MinIndex As Long Dim Index As Long For MinBound = MinBound To MaxBound - 1 'Mimimum suchen: MinIndex = MinBound For Index = MinBound + 1 To MaxBound If Strings(Index) < Strings(MinIndex) Then MinIndex = Index Next Index 'Ggf. nach vorne tauschen: If MinIndex <> MinBound Then SwapStr Strings(MinIndex), Strings(MinBound) Next MinBound End Sub
Dieser Algo benutzt ein sogenanntes Pivot-Element (hier: einfach das Mittlere), um ein Array in zwei Hälften zu teilen: Links stehen dann alle Elemente, die alphabetisch kleiner sind, rechts die größeren Elemente. Anschließend wird das Verfahren auf diese beiden Hälften rekursiv angewendet.
Da der Verwaltungsaufwand von QuickSort relativ groß ist, wird in meiner Routine bei kleinen (Rest-)Mengen auf MinSort zurückgegriffen, was einen zusätzlichen Performanceschub von durchschnittlich 30% bringt.
Public Sub QuickSortString(ByRef Strings() As String) QuickSortStringBounds Strings, LBound(Strings), UBound(Strings) End Sub
' ©2004 by Jost Schwider, http://vb-tec.de/ Public Sub QuickSortStringBounds(ByRef Strings() As String, _ ByVal MinBound As Long, ByVal MaxBound As Long) Dim MinIndex As Long Dim MaxIndex As Long Dim Pivot As String Dim Index As Long If MaxBound - MinBound < 8 Then 'Bei wenigen Elementen ist MinSort besser: MinSortStringBounds Strings, MinBound, MaxBound Else 'Array bzgl. Pivot-Element in zwei Hälften aufteilen: MinIndex = MinBound MaxIndex = MaxBound Pivot = Strings((MinBound + MaxBound) \ 2) Do Do While Strings(MinIndex) < Pivot MinIndex = MinIndex + 1 Loop Do While Strings(MaxIndex) > Pivot MaxIndex = MaxIndex - 1 Loop If MinIndex < MaxIndex Then SwapStr Strings(MinIndex), Strings(MaxIndex) MinIndex = MinIndex + 1 MaxIndex = MaxIndex - 1 Else Exit Do End If Loop 'Beide Hälften rekursiv sortieren: QuickSortStringBounds Strings, MinBound, MaxIndex QuickSortStringBounds Strings, MinIndex, MaxBound End If End Sub
© Jost Schwider, 18.02.2004-18.02.2004 - http://vb-tec.de/qsort.htm