时间戳

首页 > 解决方案 > 单列中的多个条件过滤，条件并不总是出现在数据表中

arrays - 单列中的多个条件过滤，条件并不总是出现在数据表中

问题描述

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

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

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

我想添加两个额外的暴击，暴击 3 和暴击 4。我尝试了以下方法，但无法正常工作：

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

此外，在我看来，如果该地区不存在其中一项标准，这将打破？即，缺少任何出现的 crit3 的数据集。

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

谢谢，克里斯

更新：谢谢你！花了一些时间，但我现在可以正常工作了。我真的不明白为什么我需要在 Set sht 行和过滤器数组行中进行更改，但是代码正在做我现在想要的。感谢帮助！


    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

标签： arraysvbafilteringcriteria

解决方案

在这里，我已经为您的代码修改了它 - 只需将 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

推荐阅读