Strings sortiert in Collection-Objekt einfügen Mit Hilfe dieser Funktion lassen sich Strings in der korrekten Sortierfolge in ein Collection-Objekt einfügen.
Autor:   Dieter Otter	Bewertung:     [ Jetzt bewerten ]	Views:  19.392
https://www.tools4vb.com	System:  Win9x, WinNT, Win2k, WinXP, Win7, Win8, Win10, Win11	Beispielprojekt auf CD

Geben Sie hier Ihre persönliche Bewertung ab! Anzahl Bewertungen bisher: 19 Bewertung insgesamt: gut Durchschnittliche Bewertung: 3.7 von 5 Sternen

sehr gut     gut     nützlich     mittelmäßig     mangelhaft

Das Collection-Objekt ist eine feine Sache, wäre da nicht das Manko, dass sich der Inhalt nicht sortieren lässt. Nachfolgend stellen wir Ihnen eine Funktion vor, mit der Strings bereits beim Hinzufügen in der korrekten Sortierfolge in das Collection-Objekt eingefügt werden. Zur Positions-Ermittlung wird hierzu die sogenannte "binäre Suche" verwendet, d.h. der Inhalt wird geteilt und es wird dann geprüft, ob der neue Eintrag in die "linke" oder "rechte" Hälfte eingefügt werden muss. Die betroffene "Hälfte" wird anschließend erneut geteilt und die Prüfung wiederholt. Das ganze Szenario wird solange fortgeführt, bis nicht mehr geteilt werden kann, was bedeutet, dass die korrekte Einfügeposition gefunden wurde.

' String in korrekter Sortierfolge in Collection-Objekt einfügen
' Rückgabewert: Position des Strings innerhalb der Auflistung
Public Function CollectionAddItem(oCol As Collection, _
  ByVal sItem As String, _
  Optional ByVal vKey As Variant) As Long
 
  Dim nCount As Long
  Dim nIndex As Long
  Dim nStart As Long
  Dim nEnd As Long
 
  nIndex = 1
  With oCol
    nCount = .Count
 
    ' wenn Collection-Objekt noch leer ist
    If nCount < 1 Then
      .Add sItem, vKey
    Else
      ' Neuen Eintrag mit 1. Eintrag vergleichen
      If StrComp(.Item(1), sItem, vbTextCompare) > 0 Then
        ' an 1. Position einfügen
        .Add sItem, vKey, 1
 
      ' jetzt mit letzten Eintrag vergleichen
      ElseIf StrComp(.Item(nCount), sItem, vbTextCompare) < 0 Then
        ' an letzter Position einfügen
        .Add sItem, vKey
        nIndex = nCount + 1
 
      Else
        ' durch binäre Suche die korrekte Position ermitteln
        nStart = 1: nEnd = nCount
        Do
          nIndex = (nStart + nEnd) \ 2
          If nIndex = nStart Then Exit Do
 
          ' String-Vergleich
          Select Case StrComp(.Item(nIndex), sItem, vbTextCompare)
            Case Is > 0
              ' Auflistung nach "links" halbieren und erneut suchen
              nEnd = nIndex
            Case Is < 0
              ' Auflistung nach "rechts" halbieren und erneut suchen
              nStart = nIndex
            Case Else
              Exit Do
          End Select
        Loop
        .Add sItem, vKey, , nIndex
        nIndex = nIndex + 1
      End If
    End If
  End With
 
  CollectionAddItem = nIndex
End Function

Ab sofort rufen Sie dann nicht mehr die "Add"-Methode des Collection-Objekts auf, sondern unsere neue Funktion CollectionAddItem:

Dim oCol As New Collection
 
' Namensliste in korrekter Sortierfolge in 
' Collection einfügen
CollectionAddItem oCol, "Dieter"
CollectionAddItem oCol, "Anton"
CollectionAddItem oCol, "Harald"
CollectionAddItem oCol, "Monika"
CollectionAddItem oCol, "Zorro"
CollectionAddItem oCol, "Bernhard"
' ...

' Inhalt (sortiert) in ListBox ausgeben
Dim i As Long
 
For i = 1 To oCol.Count
  List1.AddItem oCol(i)
Next i