求助：如何用Excel VBA实现COUNTIFS函数的遍历统计功能

以下是两种可行的实现方案，均满足遍历Sheet1指定区域并从Sheet2提取统计数据的需求：

方案1：循环写入计算结果（值） #

该方案直接将COUNTIFS的计算结果写入单元格，不保留公式，适合不需要后续自动更新数据的场景：

Sub CountIfsheet1()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim cell As Range
    Dim lastRowWs2 As Long
    Dim criteria1Range As Range
    Dim criteria2Range As Range
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")
    
    ' 调整列号匹配实际数据位置：假设Criteria1在Sheet2的A列，Criteria2在B列，表头在第1行
    lastRowWs2 = ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row
    Set criteria1Range = ws2.Range("A2:A" & lastRowWs2) ' 跳过表头，取实际数据范围
    Set criteria2Range = ws2.Range("B2:B" & lastRowWs2)
    
    ' 遍历Sheet1的B7:B40，对应A列的个体名称：如果B7对应A8，把Offset(0, -1)改成Offset(1, -1)
    For Each cell In ws1.Range("B7:B40")
        cell.Value = Application.WorksheetFunction.CountIfs(criteria1Range, cell.Offset(0, -1).Value, criteria2Range, "Yes")
    Next cell
End Sub

方案2：批量设置COUNTIFS公式（保留公式） #

该方案给目标区域批量写入公式，后续Sheet2数据更新时，Sheet1的统计结果会自动刷新，适合需要动态更新的场景：

Sub SetCountIfsFormula()
    Dim wb As Workbook
    Dim ws1 As Worksheet
    Dim ws2 As Worksheet
    Dim criteria1Col As String
    Dim criteria2Col As String
    Dim lastRowWs2 As Long
    
    Set wb = ThisWorkbook
    Set ws1 = wb.Sheets("Sheet1")
    Set ws2 = wb.Sheets("Sheet2")
    
    ' 调整列标识匹配实际数据位置
    criteria1Col = "A" ' Criteria1所在列
    criteria2Col = "B" ' Criteria2所在列
    lastRowWs2 = ws2.Cells(ws2.Rows.Count, criteria1Col).End(xlUp).Row
    
    ' 批量写入公式：如果B7对应A8，把公式里的A7改成A8
    ws1.Range("B7:B40").Formula = "=COUNTIFS(" & ws2.Name & "!" & criteria1Col & "2:" & criteria1Col & lastRowWs2 & ",A7," & ws2.Name & "!" & criteria2Col & "2:" & criteria2Col & lastRowWs2 & ",""Yes"")"
End Sub

关键注意事项 #

• 请根据实际数据位置调整代码中的列标识（如"A"、"B"）和行号（如"A2"），确保匹配Sheet2中Criteria1、Criteria2的实际范围。
• 若Sheet1的B7对应A8而非A7，需修改代码中cell.Offset(0, -1)为cell.Offset(1, -1)，或公式中的A7改为A8。

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