使用以数组为条件的自动过滤器并搜索包含

Question

I've done a ton of googling and couldn't find any solutions. I have a list of 5-10 items in column A, in column BI have around 500k rows (if it was less I could just loop through them).

All the cells in column B have a lot of data, and I want to filter for the ones that contain somewhere within them one of the items in column A.

My problem is that since I am using an array as criteria, I can't seem to add wildcards effectively. Does anyone have a solution? Here is my current code:

Dim LastRow As Integer
LastRow = ActiveSheet.Cells(ActiveSheet.Rows.Count, "a").End(xlUp).Row
Range("b1").AutoFilter

Dim Cri() As String
ReDim Cri(2 To LastRow)
Dim i As Integer
For i = 2 To LastRow
    Cri(i) = Cells(i, 1).Value
Next

With ActiveSheet
    .Range("b1").AutoFilter Field:=2, Criteria1:=Cri, Operator:=xlFilterValues
End With

I have tried every way I can think of to include wildcards but it does not work.

I just thought of one possible solution, looping through an if statement that finds the exact amount of criteria, and making 10 or so different possible autofilter codes. I'm not sure if that would even work but it would not be elegant at all.

Answer 1

This short sub seems to do what you are asking fairly quickly.

Sub collect_and_filter_Bs()
    Dim c As Long, v As Long, vVALs As Variant, vCRITs As Variant, rng As Range

    Application.ScreenUpdating = False

    With ActiveSheet    '<-set this worksheet reference properly
        If .AutoFilterMode Then .AutoFilterMode = False
        If IsEmpty(.Cells(2, 1)) Then Exit Sub
        vCRITs = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value2
        For c = 1 To UBound(vCRITs, 1)
            vCRITs(c, 1) = Chr(42) & vCRITs(c, 1) & Chr(42)
        Next c

        ReDim vVALs(1 To 1)

        With Intersect(.Columns(2), .Cells(1, 1).CurrentRegion)
            For c = 1 To UBound(vCRITs, 1) Step 2
                If c = UBound(vCRITs, 1) Then
                    .AutoFilter Field:=1, Criteria1:=vCRITs(c, 1)
                Else
                    .AutoFilter Field:=1, Criteria1:=vCRITs(c, 1), Operator:=xlOr, Criteria2:=vCRITs(c + 1, 1)
                End If
                With .Offset(1, 0).Resize(.Rows.Count - 1, 1)
                    If CBool(Application.Subtotal(103, .Columns(1))) Then
                        For Each rng In .SpecialCells(xlCellTypeVisible)
                            vVALs(UBound(vVALs)) = rng.Value2
                            ReDim Preserve vVALs(1 To UBound(vVALs) + 1)
                        Next rng
                    End If
                End With
                .AutoFilter Field:=1
            Next c

            ReDim Preserve vVALs(1 To UBound(vVALs) - 1)
            .AutoFilter Field:=1, Criteria1:=(vVALs), Operator:=xlFilterValues
        End With
    End With

    Application.ScreenUpdating = True

End Sub

Tested on 50K rows of random data. Leaves the worksheet with column B filtered for each of the values in column A (wildcarded by the program).