Excel VBA跨工作表循环引用Countif问题求助

背景 #

现有Excel工作簿包含3个工作表：Client、Cloud、Validation，其中Client和Cloud为原始数据源，Validation是校验目标表。需开发宏完成以下数据处理步骤，但步骤5的循环逻辑存在问题，需重新实现该循环。

宏需求步骤 #

• 将Client表数据复制到Validation表
• 将Cloud表数据粘贴到Validation表现有数据下方
• 对Validation表每列去重
• 在每列前插入5列，表头为Client、Cloud、Match、Var
• 统计Validation表中Client列对应值在Client源表中的出现次数（当前循环逻辑异常）
• 统计Cloud列对应值在Cloud源表中的出现次数
• 判断Client与Cloud列数值是否匹配
• 计算两者差值

问题循环示例（常见错误写法） #

' 错误点：逐单元格比对源表，效率极低且易遗漏边界情况
Sub WrongCountClientOccurrences()
    Dim wsVal As Worksheet, wsClient As Worksheet
    Dim lastRowVal As Long, lastRowClient As Long
    Dim i As Long, j As Long
    Dim count As Integer
    
    Set wsVal = ThisWorkbook.Worksheets("Validation")
    Set wsClient = ThisWorkbook.Worksheets("Client")
    lastRowVal = wsVal.Cells(wsVal.Rows.Count, "A").End(xlUp).Row
    lastRowClient = wsClient.Cells(wsClient.Rows.Count, "A").End(xlUp).Row
    
    ' 嵌套循环遍历，数据量大时卡顿严重
    For i = 2 To lastRowVal
        count = 0
        For j = 2 To lastRowClient
            If wsVal.Cells(i, "A").Value = wsClient.Cells(j, "A").Value Then
                count = count + 1
            End If
        Next j
        wsVal.Cells(i, "B").Value = count
    Next i
End Sub

非循环参考示例（公式法） #

' 用COUNTIF公式批量填充，无需循环但依赖公式转换
Sub NonLoopCountClientOccurrences()
    Dim wsVal As Worksheet, wsClient As Worksheet
    Dim lastRowVal As Long
    Dim rng As Range
    
    Set wsVal = ThisWorkbook.Worksheets("Validation")
    Set wsClient = ThisWorkbook.Worksheets("Client")
    lastRowVal = wsVal.Cells(wsVal.Rows.Count, "A").End(xlUp).Row
    
    ' 批量写入公式后转为数值
    Set rng = wsVal.Range("B2:B" & lastRowVal)
    rng.Formula = "=COUNTIF(Client!A:A, A2)"
    rng.Value = rng.Value
End Sub

修正后的循环实现方案（高效字典版） #

' 用字典预存源表数据统计结果，再遍历目标表填充，兼顾效率与灵活性
Sub CorrectCountClientOccurrences()
    Dim wsVal As Worksheet, wsClient As Worksheet
    Dim lastRowVal As Long, lastRowClient As Long
    Dim i As Long
    Dim clientDict As Object
    Dim cellVal As Variant
    
    ' 初始化工作表对象
    Set wsVal = ThisWorkbook.Worksheets("Validation")
    Set wsClient = ThisWorkbook.Worksheets("Client")
    Set clientDict = CreateObject("Scripting.Dictionary")
    
    ' 第一步：预统计Client表中所有值的出现次数
    lastRowClient = wsClient.Cells(wsClient.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowClient ' 假设源表表头在第1行
        cellVal = wsClient.Cells(i, "A").Value
        ' 字典不存在该值则初始化为1，存在则计数+1
        If Not clientDict.Exists(cellVal) Then
            clientDict(cellVal) = 1
        Else
            clientDict(cellVal) = clientDict(cellVal) + 1
        End If
    Next i
    
    ' 第二步：遍历Validation表的Client列，填充统计结果
    lastRowVal = wsVal.Cells(wsVal.Rows.Count, "A").End(xlUp).Row
    For i = 2 To lastRowVal
        cellVal = wsVal.Cells(i, "A").Value
        ' 根据字典判断是否存在该值，返回对应计数或0
        If clientDict.Exists(cellVal) Then
            wsVal.Cells(i, "B").Value = clientDict(cellVal) ' 统计结果写入B列，可按需调整
        Else
            wsVal.Cells(i, "B").Value = 0
        End If
    Next i
    
    ' 释放对象
    Set clientDict = Nothing
    Set wsClient = Nothing
    Set wsVal = Nothing
End Sub

方案说明 #

• 先通过一次循环将Client表的所有值统计存入字典，避免了嵌套循环带来的高时间复杂度
• 遍历Validation表时直接从字典取值，逻辑清晰，数据量大时效率提升明显
• 处理了值不存在的边界情况，返回0避免单元格出现错误值
• 该逻辑可直接复用至步骤6的Cloud列统计，只需替换工作表对象和字典名称

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