筛选器包含条件与数组

Question

我有一个用于基于数组的过滤条件的代码，但是它过滤完全匹配且不包含

。

我要过滤所有包含的内容

我有此代码可以过滤完全匹配

Criteria = Worksheets("Sheet1").Range("A1:A140") & Criteri & :*"-不起作用

    Sub Filter969696()

Dim Criteria As Variant
Dim cri() As String

Criteria = Worksheets("Sheet1").Range("A1:A140")

ReDim Preserve cri(UBound(Criteria))

For I = LBound(Criteria) To UBound(Criteria)

    cri(I) = Criteria(I, 1)

Next

Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=cri, Operator:=xlFilterValues

End Sub

过滤所有值包含提供的数组

Answer 1

在这里，尝试以下代码：

虽然我使它变得相当庞大和复杂，但是应该可以使用。

为了克服Excel对2个包含的限制，我在一个新数组中逐个添加了确切的Macthes，并使用它立即应用了过滤器。

Sub Filter969696()

Dim Criteria As Variant
Dim cri() As String
Dim cri2() As String
Dim i As Integer
Dim j As Integer
Dim k As Integer

Criteria = Worksheets("Sheet1").Range("A1:A140")

ReDim Preserve cri(UBound(Criteria))
ReDim Preserve cri2(1)

For i = LBound(Criteria) To UBound(Criteria)

    cri(i) = "=*" & Criteria(i, 1) & "*"
    Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=cri(i), Operator:=xlFilterValues

    j = UBound(cri2)

    ReDim Preserve cri2(j + Worksheets("AP").Range("$A$1:$h$100").Columns(1).SpecialCells(xlCellTypeVisible).Count)

        For Each rw In Worksheets("AP").Range("$A$1:$h$100").SpecialCells(xlCellTypeVisible).Rows

                cri2(j + 1) = Cells(rw.Row, 1).Value
                j = j + 1

        Next

Next

Worksheets("AP").Range("$A$1:$h$100").AutoFilter Field:=3, Criteria1:=cri2, Operator:=xlFilterValues


End Sub