VBA - Suche über Schaltfläche und Teileintragung
13.02.2024 15:06:34
Gecko
Beispiel:
Meine Tabelle enthält über 20.000 Einträge und ich möchte alle Einträge zu dem Datum 12.12.2021 herausfiltern. Jedoch enthält meine Ausgangstabelle das Datum zusätzlich mit Uhrzeit, also wird hier kein Suchergebnis ausgegeben.
Hier mein Code, der auch funktioniert, jedoch nur bei einer vollständigen Übereinstimmung.
Sub Schaltfläche3_Klicken()
Dim wks As Worksheet, wksS As Worksheet
Dim rng As Range
Dim sFirst As String, sFind As String, strTitel As String
Dim lRow As Long
strTitel = InputBox("Suche nach:", "Suchbegriff eingeben", , 5, 5) 'Suchdialog kreieren
lRow = 4 'Zeile ab der die gefundenen zeilen angezeigt werden
Set wks = Sheets("Daten") 'Tabelle in der gesucht wird
Set wksS = Sheets("Suche") 'Tabelle für die Ausgabe
sFind = strTitel 'Suchbegriff
wksS.Range("A4:O25000").ClearContents 'Zellen löschen
Set rng = wks.Range("A2:O24911").Find(sFind, wks.Range("O24911"), xlValues, xlWhole)
If Not rng Is Nothing Then
sFirst = rng.Address
wks.Range(wks.Cells(rng.Row, 1), wks.Cells(rng.Row, 15)).Copy _
wksS.Range(wksS.Cells(lRow, 1), wksS.Cells(lRow, 15))
lRow = lRow + 1
Do
Set rng = wks.Range("A2:O24911").FindNext(rng)
If rng.Address = sFirst Then Exit Do
wks.Range(wks.Cells(rng.Row, 1), wks.Cells(rng.Row, 15)).Copy wksS(Cells(lRow, 1))
lRow = lRow + 1
Loop
Else
MsgBox "Kein Treffer"
End If
End SubDanke für eure Hilfe