vom String Anfang suchen
15.08.2021 11:27:11
Thomas
ich kann mit dem untenstehend Makro eine Listbox rasend schnell durchsuchen.
Ist es möglich dieses Makro so zu ändern, das immer vom Wortanfang gesucht wird?
Derzeit werden alle Übereinstimmungen ausgegeben, unabhängig davon wo diese Übereinstimmung im String- Wort gefunden wird.
z.B.
Wenn man als Suchtext "ean" eingegeben wird, dann wird derzeit auch das Wort "Keane" gefunden. In diesem Beispiel soll aber "Keane " nur gefunden werden
wenn man "Kean" eingibt.
Habt schon mal rechtvielen dank für euer interesse
mfg thomas
Private Sub TextBox6_Change()
Dim ftemp(0 To 0, 0 To 25) As Variant, fDummy As Variant
'!!! diese 0 to 3 muss mit der Spaltenanzahl übereinstimmen
Dim blnHit As Boolean, i As Long, j As Long
'With Application
' .ScreenUpdating = False
' .EnableEvents = False
' '.Calculation = xlCalculationManual
'End With
If Me.TextBox6 = vbNullString Then
Me.Suchergebnisse_suchen.List = ListboxListe
' lLZeile = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
' Suchergebnisse_suchen.RowSource = "Filtertabelle!a2:x" & lLZeile + 1
Else
dic.RemoveAll
With Me.Suchergebnisse_suchen
For i = LBound(ListboxListe, 1) To UBound(ListboxListe, 1)
fDummy = Split(Me.TextBox6, " ")
For j = LBound(fDummy) To UBound(fDummy)
If InStr(1, ListboxListe(i, 1) _
& "###" & ListboxListe(i, 2) & "###" & ListboxListe(i, 3) & "###" & ListboxListe(i, 4) & "###" & ListboxListe(i, 5) _
& "###" & ListboxListe(i, 6) & "###" & ListboxListe(i, 7) & "###" & ListboxListe(i, 8) & "###" & ListboxListe(i, 9) _
& "###" & ListboxListe(i, 14) & "###" & ListboxListe(i, 15) & "###" & ListboxListe(i, 16) & "###" & ListboxListe(i, 17) _
& "###" & ListboxListe(i, 18) & "###" & ListboxListe(i, 19) & "###" & ListboxListe(i, 20) & "###" & ListboxListe(i, 21) _
& "###" & ListboxListe(i, 22) & "###" & ListboxListe(i, 23) & "###" & ListboxListe(i, 24), _
fDummy(j), vbTextCompare) Then
blnHit = True
Else
blnHit = False
Exit For
End If
Next
If blnHit Then
dic(ListboxListe(i, 1) _
& "###" & ListboxListe(i, 2) & "###" & ListboxListe(i, 3) & "###" & ListboxListe(i, 4) & "###" & ListboxListe(i, 5) _
& "###" & ListboxListe(i, 6) & "###" & ListboxListe(i, 7) & "###" & ListboxListe(i, 8) & "###" & ListboxListe(i, 9) _
& "###" & ListboxListe(i, 14) & "###" & ListboxListe(i, 15) & "###" & ListboxListe(i, 16) & "###" & ListboxListe(i, 17) _
& "###" & ListboxListe(i, 18) & "###" & ListboxListe(i, 19) & "###" & ListboxListe(i, 20) & "###" & ListboxListe(i, 21) _
& "###" & ListboxListe(i, 22) & "###" & ListboxListe(i, 23) & "###" & ListboxListe(i, 24)) _
= Array(ListboxListe(i, 1), ListboxListe(i, 2), ListboxListe(i, 3), ListboxListe(i, 4), ListboxListe(i, 5), _
ListboxListe(i, 6), ListboxListe(i, 7), ListboxListe(i, 8), ListboxListe(i, 9), ListboxListe(i, 10), _
ListboxListe(i, 11), ListboxListe(i, 12), ListboxListe(i, 13), ListboxListe(i, 14), ListboxListe(i, 15), _
ListboxListe(i, 16), ListboxListe(i, 17), ListboxListe(i, 18), ListboxListe(i, 19), ListboxListe(i, 20), _
ListboxListe(i, 21), ListboxListe(i, 22), ListboxListe(i, 23), ListboxListe(i, 24)) ' die spalten müssen immer bleiben
End If
blnHit = False
Next i
Select Case dic.Count
Case Is > 1
Zeilenzahl = dic.Count
.List = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
' .ListIndex = -1
Tabelle1.Range("a2:X20000") = ""
'ListBox1.RowSource = ""
Tabelle1.Range(Cells(2, 1), Cells(Zeilenzahl, spaltenzahl)) = ""
Tabelle1.Range("a2:x" & dic.Count) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
'''Tabelle1.Range(Tabelle1.Cells(2, 1), Tabelle1.Cells(Zeilenzahl, spaltenzahl)) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
'MsgBox dic.Count
lLZeile = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Filtertabelle!a2:x" & lLZeile + 1
Case Is = 1
fDummy = dic.items
ftemp(0, 0) = fDummy(0)(0): ftemp(0, 1) = fDummy(0)(1): ftemp(0, 2) = fDummy(0)(2): ftemp(0, 3) = fDummy(0)(3) _
: ftemp(0, 4) = fDummy(0)(4): ftemp(0, 5) = fDummy(0)(5): ftemp(0, 6) = fDummy(0)(6) _
: ftemp(0, 7) = fDummy(0)(7): ftemp(0, 8) = fDummy(0)(8): ftemp(0, 9) = fDummy(0)(9) _
: ftemp(0, 10) = fDummy(0)(10): ftemp(0, 11) = fDummy(0)(11): ftemp(0, 12) = fDummy(0)(12) _
: ftemp(0, 13) = fDummy(0)(13): ftemp(0, 14) = fDummy(0)(14): ftemp(0, 15) = fDummy(0)(15) _
: ftemp(0, 16) = fDummy(0)(16): ftemp(0, 17) = fDummy(0)(17): ftemp(0, 18) = fDummy(0)(18) _
: ftemp(0, 19) = fDummy(0)(19): ftemp(0, 20) = fDummy(0)(20): ftemp(0, 21) = fDummy(0)(21) _
: ftemp(0, 22) = fDummy(0)(22): ftemp(0, 23) = fDummy(0)(23)
.List = ftemp
Tabelle1.Range(Cells(2, 1), Cells(Zeilenzahl, spaltenzahl)) = ""
Tabelle1.Range("a2:x" & dic.Count) = WorksheetFunction.Transpose(WorksheetFunction.Transpose(dic.items))
lLZeile = Tabelle1.Cells(Rows.Count, 1).End(xlUp).Row
ListBox1.RowSource = "Filtertabelle!a2:x" & lLZeile + 1
'Suchergebnisse_suchen.RowSource = ""
.Clear
End Select
End With
End If
With Application
.ScreenUpdating = True
.EnableEvents = True
'.Calculation = xlCalculationManual
End With
End Sub