Excel VBA自动筛选：基于多列条件统计行数-牛站云

Excel VBA在数据处理中的优势，在于可以将重复性筛选与统计流程自动化，尤其是面对多列条件统计行数的需求时，比手动筛选或公式方式更加高效稳定。通过VBA可以直接控制筛选逻辑，并在筛选结果基础上快速计算符合条件的数据量，适用于报表统计、业务分析和数据清洗等场景。

在实际应用中，多列条件统计通常指同时对多个字段进行逻辑判断，例如“部门=销售且地区=华东且状态=已完成”。这种条件如果使用普通COUNTIF函数会受到结构限制，而VBA的AutoFilter与循环判断则可以灵活处理复杂组合条件。

第一种实现方案是基于AutoFilter结合可见单元格统计行数，这是最常用的方法。其核心思路是先对数据区域进行多条件筛选，再统计筛选后的可见行数。

vba
Sub CountByMultiCriteria()
    Dim ws As Worksheet
    Dim rng As Range
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set rng = ws.Range("A1").CurrentRegion
    
    rng.AutoFilter Field:=2, Criteria1:="销售"
    rng.AutoFilter Field:=3, Criteria1:="华东"
    rng.AutoFilter Field:=4, Criteria1:="已完成"
    
    Dim countResult As Long
    countResult = Application.WorksheetFunction.Subtotal(103, rng.Columns(1)) - 1
    
    MsgBox "符合条件的行数：" & countResult
End Sub

这种方式的优势在于执行速度快，适合大数据量统计，同时代码结构清晰。但需要注意字段位置必须固定，否则筛选条件容易出错。

第二种实现方案是使用数组遍历方式，通过VBA逐行判断多列条件。这种方法不依赖Excel筛选功能，逻辑更加灵活，适用于复杂条件或动态字段匹配场景。

vba
Sub CountByLoop()
    Dim ws As Worksheet
    Dim i As Long, lastRow As Long
    Dim countResult As Long
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        If ws.Cells(i, 2).Value = "销售" And _
           ws.Cells(i, 3).Value = "华东" And _
           ws.Cells(i, 4).Value = "已完成" Then
           
           countResult = countResult + 1
        End If
    Next i
    
    MsgBox "符合条件的行数：" & countResult
End Sub

这种方式虽然在大数据量下性能略低于AutoFilter，但优势是逻辑完全可控，可以自由扩展条件，例如增加模糊匹配、数值区间判断或日期范围筛选。

第三种实现方案是结合Dictionary对象进行条件统计，这种方式适合需要分组统计或多维汇总的场景。通过将符合条件的数据进行键值映射，可以实现类似透视表的效果，同时减少重复计算。

vba
Sub CountByDictionary()
    Dim ws As Worksheet
    Dim dict As Object
    Dim i As Long, lastRow As Long
    Dim key As String
    
    Set ws = ThisWorkbook.Sheets("Sheet1")
    Set dict = CreateObject("Scripting.Dictionary")
    
    lastRow = ws.Cells(ws.Rows.Count, 1).End(xlUp).Row
    
    For i = 2 To lastRow
        If ws.Cells(i, 3).Value = "华东" Then
            key = ws.Cells(i, 2).Value & "-" & ws.Cells(i, 4).Value
            
            If dict.exists(key) Then
                dict(key) = dict(key) + 1
            Else
                dict.Add key, 1
            End If
        End If
    Next i
    
    Dim k As Variant
    For Each k In dict.keys
        Debug.Print k & ":" & dict(k)
    Next k
End Sub