单列中有多个条件过滤，数据表中并不总是存在条件

问题描述

我正在尝试使用4个单独的条件过滤一列。当我通过以下操作仅使用两个标准时，我就有工作代码了：

Worksheets("Table1").Range("A1").AutoFilter Field:=3,Criteria1:="*crit1*",_
Operator:=xlOr,Criteria2:="*crit2*"

在上述情况下，字段3中始终存在crit1和crit2。

我想添加两个附加的爆击crit3和crit4。我已经尝试了以下方法，但无法使其正常工作：

Worksheets("Table1").Range("A1").AutoFilter Field:=3,Criteria1:=Array("*crit1*","*crit2*",_
                                    "*crit3*","*crit4*"),_
                                    Operator:=xlOr

此外，在我看来，如果该地区不存在任何一项标准，这是否会失败？也就是说，缺少任何出现crit3的数据集。

这样做的任何帮助都会很棒！

谢谢， 克里斯

更新：谢谢dwirony！弄乱了一些，但我现在开始工作了。我真的不明白为什么我需要在Set sht行和filter array行中进行更改，但是代码正在按照我现在想要的去做。感谢帮助！

    Sub AutoFilterWorkaround()
    
    Dim sht As Worksheet
    Dim filterarr As Variant,tofindarr As Variant
    Dim lastrow As Long,i As Long,j As Long,k As Long
    
    Set sht = Worksheets("Table1")
    lastrow = sht.Cells(sht.Rows.Count,"C").End(xlUp).Row
    
    'List the parts of the words you need to find here
    tofindarr = Array("crit1","crit2","crit3","crit4")
    
    ReDim filterarr(0 To 0)
    j = 0
    
    For k = 0 To UBound(tofindarr)
    
        For i = 2 To lastrow
            If InStr(sht.Cells(i,3).Value,tofindarr(k)) > 0 Then
                filterarr(j) = sht.Cells(i,3).Value
                j = j + 1
                ReDim Preserve filterarr(0 To j)
            End If
        Next i
    
    Next k
    
    'Filter on array
    Worksheets("Table1").Range("A1").AutoFilter Field:=3,Criteria1:=Array(filterarr),Operator:=xlFilterValues

解决方法

在这里，我已经为您的代码进行了修改-只需将crit1、2、3和4替换为您的实际条件即可：

Option Explicit

    Sub AutoFilterWorkaround()
    
    Dim sht As Worksheet
    Dim filterarr As Variant,tofindarr As Variant
    Dim lastrow As Long,i As Long,j As Long,k As Long
    
    Set sht = ThisWorkbook.Worksheets("Table1")
    lastrow = sht.Cells(sht.Rows.Count,"C").End(xlUp).Row
    
    'List the parts of the words you need to find here
    tofindarr = Array("crit1","crit2","crit3","crit4")
    
    ReDim filterarr(0 To 0)
    j = 0
    
    For k = 0 To UBound(tofindarr)
    
        For i = 2 To lastrow
            If InStr(sht.Cells(i,3).Value,tofindarr(k)) > 0 Then
                filterarr(j) = sht.Cells(i,3).Value
                j = j + 1
                ReDim Preserve filterarr(0 To j)
            End If
        Next i
    
    Next k
    
    'Filter on array
    sht.Range("$C$1:$C$" & lastrow).AutoFilter Field:=3,Criteria1:=Array(filterarr),Operator:=xlFilterValues

End Sub