VBA mit LIKE und Variable

[Detlef]

Hallo zusammen,

vielen Dank für die vielen unterschiedlichen Lösungsvorschläge. Ich werde es wohl tatsächlich mit dem Textfilter machen, weil mich die anderen Lösungen schlicht überfordern. Dafür verstehe ich deutlich zu wenig von der Materie! 
Mit Makros fände ich es eleganter, aber der Code von Gast123 funktioniert bei mir überhaupt nicht - ich bekomme jedesmal die Meldung, dass die CheckBoxes-Eigenschaft nicht zugeordnet werden kann. Offensichtlich brauche ich vorher eine CheckBox - aber wo krieg ich die her?
Wenn Ihr noch Antworten habt, gene her damit! Ich werde noch ein bisschen basteln...
Trotzdem schon jetzt vielen Dank!

[shift-del]

Offensichtlich brauche ich vorher eine CheckBox - aber wo krieg ich die her?

Hier gibt es eine Million Checkboxen:
https://onemillioncheckboxes.com/

Oder hier:
https://labs.convex.dev/million

Oder hier:
https://million-checkboxes.4jairo.live/

[Egon12]

Hallo Detlef,

hier 2 der möglichen Wege via Like Operator und InStr:

Code:

Option Explicit

Sub SucheInVereViaArrayUndLikeOp()
    Dim i&, j&, k&, arrTab(), arrErg()
    With Tabelle1.ListObjects(1)
        If .DataBodyRange Is Nothing Then Exit Sub
        arrTab = .DataBodyRange.Columns(21).Value
        ReDim arrErg(1 To .ListRows.Count, 1 To .ListColumns.Count)
    End With
    For i = LBound(arrTab) To UBound(arrTab)
        If arrTab(i, 1) Like "*" & Tabelle4.Cells(3, 4) & "*" Then
            k = k + 1
            For j = 1 To UBound(arrErg, 2)
                arrErg(k, j) = Tabelle1.ListObjects(1).DataBodyRange.Cells(i, j)
            Next j
        End If
    Next i
    With Tabelle3
        .UsedRange.Offset(1).ClearContents
        .Cells(2, 1).Resize(k, UBound(arrErg, 2)) = arrErg
    End With
End Sub

Sub SucheInVereviaArrayUndInStr()
    Dim i&, j&, k&, arrTab(), arrErg()
    With Tabelle1.ListObjects(1)
        If .DataBodyRange Is Nothing Then Exit Sub
        arrTab = .DataBodyRange.Columns(21).Value
        ReDim arrErg(1 To .ListRows.Count, 1 To .ListColumns.Count)
    End With
    For i = LBound(arrTab) To UBound(arrTab)
        If InStr(1, arrTab(i, 1), Tabelle4.Cells(3, 4)) > 0 Then
            k = k + 1
            For j = 1 To UBound(arrErg, 2)
                arrErg(k, j) = Tabelle1.ListObjects(1).DataBodyRange.Cells(i, j)
            Next j
        End If
    Next i
    With Tabelle3
        .UsedRange.Offset(1).ClearContents
        .Cells(2, 1).Resize(k, UBound(arrErg, 2)) = arrErg
    End With
End Sub

Deinen Button eine der beiden Prozeduren zuordnen schaffst du selbst.

Wenn du jetzt die Datei ein paar relevanten Datensätzen anonymisiert bis Spalte CC  hochlädst und sicher ist, das sich die Anzahl Spalten nicht mehr ändert, kann man dir auch noch ein Beispiel mit AdvancedFilter zusammenstellen.

Wieviel Spalten und Zeilen die Funktion =Filter() packt kann ich nicht sagen. Dies müsstest du einfach selbst ausprobieren.

Gruß Uwe

[Gast 123]

Hallo

ich dachte du wüßtest das, Sorry!  Findest du im Menü "Entwicklertools" unter Einfügen!
Oder kopiere sie einfach aus der unteren Beispieldatei in dein Original.
Das Makro bei mir läuft einwandfrei, überzeuge dich bitte selbst.

mfg Gast 123

[Detlef]

Perfekt!

Vielen, vielen Dank!