|
Das  Collection-Objekt
verfügt leider über keinerlei Fähigkeiten zur Sortierung der
enthaltenen Elemente. Zwei Wege führen zu einer sortierten
Collection. Der eine wäre, nach jedem Einfügen eines Elements die
Collection neu zu sortieren - ein sicherlich ineffizienter Weg. Der
andere Weg ist, jedes Element gleich an der richtigen Stelle
einzufügen. Dazu könnten Sie alle Elemente der Collection der
Reihe nach mit dem einzufügenden Element so lange vergleichen, bis
Sie die passende Stelle gefunden haben. Falls sich die passende
Stelle erst weit hinten findet, ist das auch nicht sehr effizient,
vor allem dann, wenn die Collection bereits viele Elemente enthält.
Die effizienteste Methode ist die so genannte "binäre
Suche" nach der passenden Stelle. Dabei wird der Inhalt
geteilt, und es wird geprüft, ob das neue Element in die obere oder
untere Hälfte einzufügen ist. Die betreffende Hälfte wird erneut
geteilt, und wieder wird geprüft, in welche der neuen Hälften das
neue Element gehört. Die Teilung und Prüfung wird so lange
fortgeführt, bis nicht mehr geteilt werden kann. Die passende
Stelle ist gefunden und das neue Element wird eingefügt.
Damit dieses Prinzip einwandfrei funktionieren kann, dürfen Sie
keine Elemente auf andere Weise einfügen. Wie gewohnt können Sie
jedoch Elemente aus der Collection entfernen.
Bei Collections, die Strings enthalten, sollten Sie zur Prüfung
die Visual Basic-Funktion StrComp
verwenden. Sie ermöglicht wahlweise einen Vergleich nach
Asci-Sortierung (vbBinaryCompare, alle Großbuchstaben vor allen
Kleinbuchstaben) oder eine lexikonähnliche Sortierung (vbTextCompare,
ohne Berücksichtigung von Groß- oder Kleinschreibung).
Die Funktion AddSortedStr fügt ein String-Element sortiert in
eine Collection ein. Optional können Sie zusätzlich einen
Schlüssel (Key) angeben, der jedoch auf die Sortierreihenfolge
keinen Einfluss hat. Ebenso optional ist die Angabe der oben
erwähnten Vergleichsmethode - voreingestellt ist die
Asci-Sortierung (vbBinaryCompare). Die Funktion gibt anschließend
den Index des neu eingefügten Elements zurück.
Public Function AddSortedStr(Collection As Collection, _
Item As String, Optional Key As Variant, _
Optional ByVal CompareMethod As VbCompareMethod = vbBinaryCompare) _
As Long
Dim nCount As Long
Dim nHigh As Long
Dim nLow As Long
Dim nTest As Long
With Collection
nCount = .Count
If nCount Then
If StrComp(Item, .Item(1), CompareMethod) < 0 Then
.Add Item, Key, 1
AddSortedStr = 1
ElseIf StrComp(Item, .Item(nCount), CompareMethod) > 0 Then
.Add Item, Key
AddSortedStr = nCount + 1
Else
nLow = 1
nHigh = nCount
Do
nTest = (nLow + nHigh) \ 2
If nTest = nLow Then
Exit Do
End If
Select Case StrComp(Item, .Item(nTest), CompareMethod)
Case Is < 0
nHigh = nTest
Case 0
Exit Do
Case Is > 0
nLow = nTest
End Select
Loop
If nTest < nCount Then
Do While StrComp(.Item(nTest + 1), Item, CompareMethod) = 0
nTest = nTest + 1
If nTest = nCount Then
Exit Do
End If
Loop
End If
.Add Item, Key, , nTest
AddSortedStr = nTest + 1
End If
Else
.Add Item, Key
AddSortedStr = 1
End If
End With
End Function
Bei Collections, die numerische Werte sortiert aufnehmen sollen,
erübrigt sich die Vergleichsmethode. Als Beispiel sehen Sie im
folgenden die Funktion AddSortedInt, die Integer-Werte in eine
Collection sortiert einfügt. Die Funktionen für die weiteren
numerischen Datentypen Long, Single, Double und Currency sind
identisch. Sie unterscheiden sich lediglich im Namen (AddSortedLng,
AddSortedSng, AddSortedDbl und AddSortedCur) und im Datentyp des
Item-Parameters.
Public Function AddSortedInt(Collection As Collection, _
Item As Integer, Optional Key As Variant) As Long
Dim nCount As Long
Dim nHigh As Long
Dim nLow As Long
Dim nTest As Long
Dim nTestItem As Integer
With Collection
nCount = .Count
If nCount Then
If Item < .Item(1) Then
.Add Item, Key, 1
AddSortedInt = 1
ElseIf Item > .Item(nCount) Then
.Add Item, Key
AddSortedInt = nCount + 1
Else
nLow = 1
nHigh = nCount
Do
nTest = (nLow + nHigh) \ 2
If nTest = nLow Then
Exit Do
End If
nTestItem = .Item(nTest)
Select Case Item
Case Is < nTestItem
nHigh = nTest
Case nTestItem
Exit Do
Case Is > nTestItem
nLow = nTest
End Select
Loop
If nTest < nCount Then
Do While .Item(nTest + 1) = Item
nTest = nTest + 1
If nTest = nCount Then
Exit Do
End If
Loop
End If
.Add Item, Key, , nTest
AddSortedInt = nTest + 1
End If
Else
.Add Item, Key
AddSortedInt = 1
End If
End With
End Function
|