VBA实现Excel工作簿内指定工作表对的循环对比

你只需要新增一层循环遍历你预设的工作表配对集合，替换原代码中硬编码的单组工作表即可，优化后代码也移除了不必要的Activate操作，避免运行过程中误切换工作表导致的计算错误。

完整修改后代码 #

Dim x As Integer
Dim y As Integer
Dim year1, year2 As Integer
Dim strname1, strname2, strname3, strname4 As String
Dim st, p, sheetPair
' 定义所有需要对比的工作表对，可按需新增
' 单组参数规则：Array(左表名, 右表名, 左表求和区域, 左表年份条件区域, 左表性别条件区域, 右表求和区域, 右表年份条件区域, 右表性别条件区域)
Dim SheetPairs As Variant
SheetPairs = Array( _
    Array("a", "d", "F9:F250", "C9:C250", "E9:E250", "F7:F30", "C7:C30", "D7:D30"), _
    Array("b", "e", "F9:F250", "C9:C250", "E9:E250", "F7:F30", "C7:C30", "D7:D30"), _
    Array("c", "f", "F9:F250", "C9:C250", "E9:E250", "F7:F30", "C7:C30", "D7:D30") _
    ' 可继续添加更多配对
)

strname1 = "Female"
strname2 = "Male"
strname3 = "Other"
strname4 = "Unknown"
year1 = 2019
year2 = 2020

' 外层循环遍历每一组工作表对
For Each sheetPair In SheetPairs
    For Each p In Array(2019, 2020)
        For Each st In Array(strname1, strname2, strname3, strname4)
            ' 直接指定工作表计算，无需激活
            x = WorksheetFunction.SumIfs(Worksheets(sheetPair(0)).Range(sheetPair(2)), _
                Worksheets(sheetPair(0)).Range(sheetPair(3)), p, _
                Worksheets(sheetPair(0)).Range(sheetPair(4)), st)
            y = WorksheetFunction.SumIfs(Worksheets(sheetPair(1)).Range(sheetPair(5)), _
                Worksheets(sheetPair(1)).Range(sheetPair(6)), p, _
                Worksheets(sheetPair(1)).Range(sheetPair(7)), st)
            If x = y Then
                MsgBox "[" & sheetPair(0) & "与" & sheetPair(1) & "] 验证通过：" & p & " " & st & " 人数匹配"
            Else
                MsgBox "[" & sheetPair(0) & "与" & sheetPair(1) & "] 验证失败：" & p & " " & st & " 人数不匹配"
            End If
        Next st
    Next p
Next sheetPair

使用说明 #

• 如果后续需要新增配对，只需按照格式往SheetPairs数组中添加新行即可，不需要修改核心逻辑
• 如果不同工作表对的求和、条件区域规则不同，直接修改对应数组项里的区域参数即可，互不影响
• 提示信息里已经标注了当前对比的工作表组，出现错误时可以直接定位到对应工作表对

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