vb@rchiv
VB Classic
VB.NET
ADO.NET
VBA
C#
Mails senden, abrufen und decodieren - ganz easy ;-)  
 vb@rchiv Quick-Search: Suche startenErweiterte Suche starten   RSS-Feeds  | Newsletter  | Impressum  | Datenschutz  | vb@rchiv CD Vol.6  | Shop Copyright ©2000-2019
 
zurück
Rubrik: Variablen/Strings · Sonstiges   |   VB-Versionen: VB615.03.07
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 OtterBewertung:     [ Jetzt bewerten ]Views:  16.992 
www.tools4vb.deSystem:  Win9x, WinNT, Win2k, WinXP, Vista, Win7, Win8, Win10 Beispielprojekt auf CD 

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

Dieser Tipp wurde bereits 16.992 mal aufgerufen.

Voriger Tipp   |   Zufälliger Tipp   |   Nächster Tipp

Über diesen Tipp im Forum diskutieren
Haben Sie Fragen oder Anregungen zu diesem Tipp, können Sie gerne mit anderen darüber in unserem Forum diskutieren.

Neue Diskussion eröffnen

nach obenzurück


Anzeige

Kauftipp Unser Dauerbrenner!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.
 
   

Druckansicht Druckansicht Copyright ©2000-2019 vb@rchiv Dieter Otter
Alle Rechte vorbehalten.
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.

Diese Seiten wurden optimiert für eine Bildschirmauflösung von mind. 1280x1024 Pixel