VBA可以使用数组中的Criteria值过滤电子表格 [英] VBA to Filter a spreadsheet with Criteria values in a array

问题描述

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

I have a code for filter criteria based on a array, but it filters exact match and not contains.

我要过滤所有包含的内容

I want to filter all contains

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

I have the code this filters exact match

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

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

Filter all values contains the array provided

推荐答案

在这里，尝试以下代码:

我做了一个很大的&虽然很复杂，但应该可以.

I made it a quite big & Complex though, but it should work.

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

Too overcome the Excel restriction of 2 Contains, i added the exact macthes one by one in a new array and used it to apply the filter at once.

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

这篇关于VBA可以使用数组中的Criteria值过滤电子表格的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！