Hallo excelfreunde,
mit dem folgenden Makro kann ich komfortabel meine Listbox spaltenweise durchsuchen.
' Achtung dies Option Compare Text gehört mit dazu
'https://www.ms-office-forum.net/forum/showthread.php?t=268236
'ransi
Dim arr
Dim i As Integer
Dim K As Long
Dim out As Variant
Dim L As Long
Dim dblStart As Double
With Application
.ScreenUpdating = False
'.Calculation = xlCalculationManual
.EnableEvents = False
End With
dblStart = Timer
Tabelle1.Range("a2:x20000") = ""
'Suchergebnisse_suchen_2.Clear
arr = Sheets("Kundendaten").Range("A3:X2000")
ReDim out(1 To UBound(arr, 2), 1 To UBound(arr))
For L = 1 To UBound(arr)
' Then
If LCase(arr(L, 1)) Like LCase(Kunden_suchen_2.TextBox1.Text) & "*" And _
LCase(arr(L, 2)) Like LCase(Kunden_suchen_2.TextBox2.Text) & "*" And _
LCase(arr(L, 3)) Like LCase(Kunden_suchen_2.TextBox3.Text) & "*" And _
LCase(arr(L, 4)) Like LCase(Kunden_suchen_2.TextBox4.Text) & "*" And _
LCase(arr(L, 5)) Like LCase(Kunden_suchen_2.TextBox5.Text) & "*" _
Then
K = K + 1
For i = 1 To UBound(arr, 2)
out(i, K) = arr(L, i)
Next
End If
Next
On Error Resume Next
ReDim Preserve out(1 To i - 1, 1 To K)
On Error GoTo 0
out = myTranspose(out) ' hier wir die Function myTranspose(arr) gebraucht
Tabelle1.Range("a2:x" & K + 1) = out
Dim lLZeile As Integer
Tabelle6.Range("a2:x2").Copy Tabelle1.Range("a1:x1")
lLZeile = Tabelle6.Cells(Rows.Count, 1).End(xlUp).Row
Suchergebnisse_suchen_2.RowSource = "filtertabelle!a2:Z" & lLZeile
With Application
.ScreenUpdating = True
'.Calculation = xlCalculationManual
.EnableEvents = True
End With
End Sub
Nun wäre es cool wenn man mit einem Textfeld (z.B die Spalte Name) mehrere Suchwörter in der betroffenen Spalte finden würde.
z.B. Eintrag in die TextBox ( Name ) Kai & sim.
Anschließend werden in der Listbox alle Datensätze die als Vorname Kai bzw. sim haben gezeigt.
Kann man so etwas realisieren?
mfg Thomas