Wer kennt das Problem nicht? Im Rahmen eines grösseren Datenbankprojekts habe ich dieses Problem seinerzeit mit einer ebenso simplen wie effektiven Funktion gelöst, die ich heute hier vorstellen möchte. Die Funktion ist sicherlich vielseitig einsetz- und auch erweiterbar. Im beigefügten Beispiel verwende ich sie als Hilfe für den Benutzer, der nach einem bestimmten Eintrag sucht bzw. nach Einträgen sucht, in denen bestimmte Zeichen vorkommen. Die Funktion findet z.B.:
Damit nicht nur der erste Eintrag, welcher dem Suchkriterium entspricht, zurückgeliefert wird, durchsucht die Funktion immer nach folgender Logik:
Um nun bspw. die 2te Übereinstimmung - falls vorhanden - zu erhalten, ruft man die Funktion mit den gleichen Parametern einfach 2x auf. Im nachfolgendem Anwendungsbeispiel wird in einem Listenfeld nach einer Zeichenkette immer dann gesucht, wenn:
Hier nun der Code, welcher aus 2 Teilen besteht:
Teil 1: Code für das Formular
Private Sub Form_Load() ' Listenfeld zu Demonstrationszwecken mit 200 ' zufälligen Zahlen im Bereich 100-1000 füllen... Dim i As Integer For i = 1 To 200 List1.AddItem Int((1000 - 100 + 1) * Rnd + 100) Next i ' ein paar Vorgaben (reine Optik) With Text1 .Text = "" .TabIndex = 0 End With Command1.Caption = ">" End Sub Private Sub Text1_Change() ' Bei Änderung des Textfeldes "Text1" wird nach der ' dort eingetragenen Zeichenkette in "List1" gesucht List1.ListIndex = LstCboSearch(List1, Text1.Text) End Sub Private Sub Command1_Click() ' Bei KLICK auf den Button "Command1" wird ' nach der in "Text1" eingetragenen Zeichenkette gesucht ' Hierdurch wird die 2te, 3te usw ' Übereinstimmung - falls vorhanden - "geliefert" List1.ListIndex = LstCboSearch(List1, Text1.Text) End Sub Teil 2: Code für Modul (Funktion) ' Funktion "LstCboSearch" ' Liefert den LISTINDEX eines bestimmten Eintrags zurück, nach ' dem exakt und in Teilmengen gesucht werden kann ' ' Es wird exakt und/oder nach Teilmengen gesucht ' zB liefert die Suche nach ' "10" ' "10", "101","410" usw zurück ' ' Es wird immer ab dem aktuell markierten Listeneintrag bis zum ' Ende einer Liste und dann - falls erforderlich - wieder vom ' Listenbeginn bis zum markierten Listeneintrag gesucht. ' Durch mehrfachen Aufruf (siehe Codebeispiel für Formular) ' werden somit alle Werte - und nicht nur der erste - einer Liste ' zurückgeliefert, die dem Suchkriterium entsprechen. ' ' Parameter: ' ObjLstCbo = Objekt (ListBox oder ComboBox) dessen Einträge ' durchsucht werden sollen ' GesuchterEintrag = Listeneintrag, nach dem gesucht wird ' ' Optionale Parameter: ' Suchbeginn = Position, ab der in den Listeneinträgen nach einer ' Übereinstimmung gesucht werden soll ' (Vorgabewert ist 1) Public Function LstCboSearch(ObjLstCbo As Object, GesuchterEintrag As String, _ Optional Suchbeginn As Integer = 1) As Integer Dim ListenEintrag As String Dim Liste As Integer Dim GefundenePos As Integer Dim ListenPos As Integer ' AUSSCHLIESSEN VON FEHLERN ' Wurde ein GesuchterEintrag übergeben, nach dem gesucht werden soll? If GesuchterEintrag = "" Then ' Nein ' Funktion beenden LstCboSearch = -1 Exit Function End If ' Enthält die zu durchsuchende Liste Einträge? If ObjLstCbo.ListCount = 0 Then ' Nein ' Funktion beenden LstCboSearch = -1 Exit Function End If ' SUCHE NACH LISTENEINTRAG With ObjLstCbo ListenPos = .ListIndex ' Ende der zu durchsuchenden Liste erreicht? If ListenPos + 1 > .ListCount - 1 Then ' Ja ' Suche von vorne beginnen ListenPos = 0 Else ' Nein ' Positionszähler erhöhen ListenPos = ListenPos + 1 End If ' Liste von Positionszähler bis Listenende durchsuchen For Liste = ListenPos To .ListCount - 1 ListenEintrag = UCase$(Mid$(.List(Liste), Suchbeginn, Len(.List(Liste)))) GefundenePos = InStr(ListenEintrag, UCase$(GesuchterEintrag)) ' Wurde der Eintrag gefunden? If GefundenePos > 0 Then ' Ja ' Listindex zurückgeben LstCboSearch = Liste ' Funktion beenden Exit Function End If Next Liste ' Wurde die Suche von einer Position >1 gestartet? If ListenPos > 0 Then ' Ja ' Dann zusätzlich vom Listenbeginn bis zur übergebenen ' Listenposition suchen For Liste = 0 To ListenPos ' Wurde der Eintrag gefunden? GefundenePos = InStr(UCase$(.List(Liste)), UCase$(GesuchterEintrag)) If GefundenePos > 0 Then ' Ja ' Listindex zurückgeben LstCboSearch = Liste ' Funktion beenden Exit Function End If Next Liste End If ' kein Suchergebnis, keinen Listeneintrag markieren LstCboSearch = -1 End With End Function Dieser Tipp wurde bereits 13.538 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. |