如何用VBA.Filter函数实现多匹配筛选及对应列求和？

嘿，我明白你想用VBA.Filter处理多条件筛选的需求，虽然它本身只支持单个字符串匹配条件，但我们可以通过两次调用+数组合并的方式绕开这个限制！下面我给你详细的解决方案，分两步走：先筛选出目标列里的所有1和2，再基于筛选结果对对应列的数值求和。

第一步：用VBA.Filter实现多条件筛选（匹配1和2） #

首先，VBA.Filter是按子字符串匹配的，对于你的单个数字元素（1、2、3等），直接匹配"1"和"2"不会有歧义。我们可以先分别筛选出包含1和2的元素，再把两个结果数组合并成一个0索引的一维数组。

示例代码： #

Sub FilterMultipleValues()
    ' 定义原始数据（模拟你提供的表格，0索引二维数组）
    Dim originalData As Variant
    originalData = Array( _
        Array("A", "B", "C", "D", "CWT1", "ATR1", "ATR2", "ATR3"), _
        Array(1, 2, 3, 4, 1, 1, 3, 1), _
        Array(3, 1, 5, 7, 3, 2, 2, 1), _
        Array(4, 5, 2, 1, 6, 7, 5, 4), _
        Array(4, 5, 2, 2, 1, 3, 2, 4), _
        Array(1, 3, 3, 7, 0, 0, 0, 0) _
    )
    
    ' 提取目标列（比如第2列，索引为1，0索引）到一维数组
    Dim targetCol() As Variant
    ReDim targetCol(LBound(originalData) To UBound(originalData))
    Dim i As Long
    For i = LBound(originalData) To UBound(originalData)
        targetCol(i) = originalData(i)(1)
    Next i
    
    ' 第一次筛选：匹配所有1
    Dim filtered1 As Variant
    filtered1 = VBA.Filter(targetCol, "1", True, vbTextCompare)
    ' 第二次筛选：匹配所有2
    Dim filtered2 As Variant
    filtered2 = VBA.Filter(targetCol, "2", True, vbTextCompare)
    
    ' 合并两个筛选结果为一个0索引的一维数组
    Dim combinedFiltered() As Variant
    ReDim combinedFiltered(0 To UBound(filtered1) + UBound(filtered2) + 1)
    Dim j As Long, k As Long
    j = 0
    ' 添加筛选出的1
    For k = LBound(filtered1) To UBound(filtered1)
        combinedFiltered(j) = CDbl(filtered1(k)) ' 转成数值类型（可选，根据需求）
        j = j + 1
    Next k
    ' 添加筛选出的2
    For k = LBound(filtered2) To UBound(filtered2)
        combinedFiltered(j) = CDbl(filtered2(k))
        j = j + 1
    Next k
    
    ' 可选：去除数组末尾的空值（如果合并后有多余位置）
    ReDim Preserve combinedFiltered(0 To j - 1)
    
    ' 输出结果（验证用）
    Debug.Print "筛选后的数组："
    For Each elem In combinedFiltered
        Debug.Print elem
    Next elem
End Sub

关键说明： #

• 因为VBA.Filter返回的是字符串数组，所以如果需要数值类型，可以用CDbl()或CLng()转换。
• 合并数组时要注意索引的计算，确保最终是0索引的一维数组。

第二步：基于筛选结果对对应列求和 #

如果你的需求是：当目标列的元素是1或2时，对原数据中另一列的数值求和，我们可以结合VBA.Filter的结果找到对应的行索引，再累加对应列的数值。

优化后的示例代码（包含筛选+求和）： #

Sub FilterAndSum()
    Dim originalData As Variant
    originalData = Array( _
        Array("A", "B", "C", "D", "CWT1", "ATR1", "ATR2", "ATR3"), _
        Array(1, 2, 3, 4, 1, 1, 3, 1), _
        Array(3, 1, 5, 7, 3, 2, 2, 1), _
        Array(4, 5, 2, 1, 6, 7, 5, 4), _
        Array(4, 5, 2, 2, 1, 3, 2, 4), _
        Array(1, 3, 3, 7, 0, 0, 0, 0) _
    )
    
    ' 目标列索引（比如第2列，索引1），求和列索引（比如ATR1列，索引5）
    Const targetColIdx As Long = 1
    Const sumColIdx As Long = 5
    
    ' 生成带行索引的目标列元素（格式："值|行索引"），方便筛选后定位原行
    Dim indexedTarget() As String
    ReDim indexedTarget(LBound(originalData) To UBound(originalData))
    Dim i As Long
    For i = LBound(originalData) To UBound(originalData)
        indexedTarget(i) = originalData(i)(targetColIdx) & "|" & i
    Next i
    
    ' 筛选包含1和2的行索引字符串
    Dim filtered1 As Variant, filtered2 As Variant
    filtered1 = VBA.Filter(indexedTarget, "1|", True, vbTextCompare)
    filtered2 = VBA.Filter(indexedTarget, "2|", True, vbTextCompare)
    
    ' 合并筛选结果
    Dim combinedIndices As Variant
    ReDim combinedIndices(0 To UBound(filtered1) + UBound(filtered2) + 1)
    Dim j As Long, k As Long
    j = 0
    For k = LBound(filtered1) To UBound(filtered1)
        combinedIndices(j) = filtered1(k)
        j = j + 1
    Next k
    For k = LBound(filtered2) To UBound(filtered2)
        combinedIndices(j) = filtered2(k)
        j = j + 1
    Next k
    ReDim Preserve combinedIndices(0 To j - 1)
    
    ' 计算对应列的求和结果
    Dim sumResult As Double
    sumResult = 0
    Dim rowIndex As Long
    For Each elem In combinedIndices
        rowIndex = CLng(Split(elem, "|")(1))
        ' 跳过表头行（如果第一行是表头）
        If rowIndex > LBound(originalData) Then
            sumResult = sumResult + originalData(rowIndex)(sumColIdx)
        End If
    Next elem
    
    ' 输出结果
    MsgBox "对应列的求和结果：" & sumResult
    Debug.Print "求和结果：" & sumResult
End Sub

关键说明： #

• 我们通过在目标列元素后拼接行索引（比如"2|1"），这样筛选后可以直接拆分得到原数据的行位置，避免二次遍历原数组。
• 如果不需要保留筛选后的数组，也可以直接遍历原数组判断元素是否为1或2，这样更高效（但没用到VBA.Filter），代码会更简洁：

' 直接遍历求和的简化版（无需Filter）
Dim sumResult As Double
sumResult = 0
For i = LBound(originalData) + 1 To UBound(originalData) ' 跳过表头
    If originalData(i)(targetColIdx) = 1 Or originalData(i)(targetColIdx) = 2 Then
        sumResult = sumResult + originalData(i)(sumColIdx)
    End If
Next i

内容的提问来源于stack exchange，提问作者sifar