Excel VBA自动筛选数组

我正在使用VBA和Microsoft Excel中的自动过滤器。我有一个问题，它如何处理过滤数组；我已经将我的原始上下文淡化为一个简化版本（最初是希望理解这个问题）：

在A1:A5范围内的工作表中，假设我们分别有

水果

，

苹果

，

香蕉

，

橙色

，和

梨

。已应用自动筛选，因此

水果

是列标题

运行以下代码将返回预期结果（

Apple

、

Banana

和

Orange

，但不返回

Pear

）：

在我正在处理的项目中，过滤条件作为字符串变量传入，如上所述。问题是，并不是每一个标准每次都适用，所以其中一些标准应该没有效果

例如：

Dim A As String, B As String, C As String
A = "=*an*"
B = Empty
C = "=*ap*"

Range("A1").Select
ActiveSheet.Range("A1:A5").AutoFilter Field:=1, _
    Criteria1:=Array(A, B, C), Operator:=xlFilterValues

当

B

被抛出到混合中时，过滤不会返回任何记录（无论是保留为null、设置为

空

、还是使用通配符，如

=*

）。但是，将实际条件数组中的

B

替换为

Empty

（硬编码）将返回预期结果

我在过去使用过类似的代码（并且已经成功了），尽管它是ListObject的一部分。此时，我唯一能想到的是将过滤器连接成一个带分隔符的字符串，并将其拆分成一个数组变量（这样它就是精确的大小，因为集合中的未设置项会像标准变量一样将其弄乱）。但这似乎既不直观又麻烦

---

我是否遗漏了一些明显的东西？

我想不出一种不涉及空参数测试的方法来实现这一点，这里有一种方法可能适用于您，也可以防止重复的表达式

Sub Main()
    Dim a As String
    Dim B As String
    Dim C As String
    Dim filterCriteria as Variant
    a = "=*an*"
    B = Empty
    C = "=*ap*"
    filterCriteria = CombineArrays(Array(a, B, C))

    If Not uBound(filterCriteria) = -1 Then 

        Range("A1").Select
        ActiveSheet.Range("A1:A5").AutoFilter Field:=1, _
            Criteria1:=filterCriteria, Operator:=xlFilterValues

    End If
End Sub

Function CombineArrays(arr As Variant) As Variant
    Dim a As Variant
    Dim filterDic As Object 'Scripting.Dictionary
    Set filterDic = CreateObject("Scripting.Dictionary")

    For Each a In arr
        If Not filterDic.Exists(a) And Not a = vbNullString Then
            filterDic.Add a, a
        End If
    Next

    CombineArrays = filterDic.Keys

    Set filterDic = Nothing
End Function

---

太晚了，但我认为您可以在填充字典时忽略条件，因为它不会添加具有字典中已存在的键的项，除非您将其添加到更快的循环中。@AntiDrondert是的，您可以忽略存在检查，但不能使用add方法，您只需隐式执行

filterDic（a）=a

。

Sub Main()
    Dim a As String
    Dim B As String
    Dim C As String
    Dim filterCriteria as Variant
    a = "=*an*"
    B = Empty
    C = "=*ap*"
    filterCriteria = CombineArrays(Array(a, B, C))

    If Not uBound(filterCriteria) = -1 Then 

        Range("A1").Select
        ActiveSheet.Range("A1:A5").AutoFilter Field:=1, _
            Criteria1:=filterCriteria, Operator:=xlFilterValues

    End If
End Sub

Function CombineArrays(arr As Variant) As Variant
    Dim a As Variant
    Dim filterDic As Object 'Scripting.Dictionary
    Set filterDic = CreateObject("Scripting.Dictionary")

    For Each a In arr
        If Not filterDic.Exists(a) And Not a = vbNullString Then
            filterDic.Add a, a
        End If
    Next

    CombineArrays = filterDic.Keys

    Set filterDic = Nothing
End Function