VBA跨工作表批量执行SUMIF函数问题及调试求助

问题背景 #

• 两张工作表：RsOut（对应代码中的FID GDMR - Output_2）和rsTrans（对应DEL SOURCE_Translator），需通过唯一标识符匹配，用rsTrans的数据覆盖RsOut指定列
• 核心需求：对所有有数据的行执行SUMIF，且需重复操作约15次，求高效实现方式
• 遇到的问题：原代码报运行时错误1004；测试代码出现#NAME?错误+文件选择弹窗

原代码与错误分析 #

原代码触发运行时错误1004（Set sumRange行报错），代码如下：

Sub SumifmovewsTransdatatowsOut()
    Dim wb As Workbook, wsOut As Worksheet
    Dim wsTrans As Worksheet, rngList As Range
    
    Dim sumRange As Range
    Dim criteriaRange As Range
    Dim criteria As Long  'Setting as long because the IDs (criteria) are at least 20 characters. Should this be a range??
    
    Set wb = ThisWorkbook
    Set wsTrans = Worksheets("DEL SOURCE_Translator")  'Worksheet that contains analysis and results that need to be inserted into wsOut
        
    Set wsOut = Worksheets("FID GDMR - Output_2") 'Worksheet where you are pasting results from wsOut
    Set rngList = wsOut.Range("B2:B" & wsOut.Cells(Rows.Count, "B").End(xlUp).Row)  'this range of IDs will be different every run, thus adding in the count to find last row...or do I not need the rnglist at all? Just run the sumif for all criteria B2:b
    
    Set sumRange = wsTrans.Range("ag21:ag")  'Values in wsTrans that need to be added to wsOut
    Set criteriaRange = wsTrans.Range("AA21:AA")  'Range of IDs found on wsTrans
    criteria = rngList
                   
    Sumif
  
End Sub

'Standard Sumif formula
Sub Sumif()
     wsOut.Range("AT2:AT") = WorksheetFunction.SumIfs(sumRange, criteriaRange, criteria)
End Sub
'OR should the Sumif formula be:   rng.Formula = "=SUMIF(criteriaRange,rngList,sumRange)"

错误原因 #

1. 范围定义错误：wsTrans.Range("ag21:ag")未指定最后行，Excel无法识别完整有效范围
2. 类型不匹配：criteria定义为Long，但ID是20+字符的文本，且直接赋值Range对象给Long变量
3. 作用域错误：子过程Sumif未接收外部变量，直接使用未定义的全局变量
4. 函数参数错误：WorksheetFunction.SumIfs无法直接对整个Range批量赋值，且参数顺序、用法不符合要求

测试代码问题与排查 #

测试代码出现单元格#NAME?错误+文件选择弹窗，代码如下：

Sub test2()
Dim wsTrans As Worksheet: Dim wsOut As Worksheet
Dim rgCrit As String: Dim rgSum As String
Dim rgR As Range: Dim i As Integer: Dim arr

arr = Array("AG:AT", "AJ:BB", "AM:BJ", "AT:BR", "AZ:CA", "BP:DE", "BW:DO") 'change as needed
Set wsTrans = Sheets("DEL SOURCE_Translator")         'change as needed
Set wsOut = Sheets("FID GDMR - Output_2")           'change as needed
rgCrit = wsTrans.Name & "!" & wsTrans.Columns(27).Address  'Column 27 is AA in wsTrans which contains the criteria range
Set rgR = wsOut.Range("B2", wsOut.Range("B2").End(xlDown)) 'change as needed
startCell = "$" & Replace(rgR(1, 1).Address, "$", "")

For i = LBound(arr) To UBound(arr)
    rgSum = wsTrans.Name & "!" & Split(arr(i), ":")(0) & ":" & Split(arr(i), ":")(0)
        With rgR.Offset(0, Range(Split(arr(i), ":")(1) & 1).Column - rgR.Column)
            .Value = "=SUMIF(" & rgCrit & "," & startCell & "," & rgSum & ")"
            .Value = .Value
        End With
Next

End Sub


'Sum Ranges in wsTrans:     AG, AJ, AM, AT, AZ, BP, BW
'Result Columns in wsOut:   AT, BB, BJ, BR, CA, DE, DO

错误原因 #

1. 文件选择弹窗+工作表名称缺失前缀：工作表名称含空格，拼接公式时未用单引号包裹，Excel将其识别为外部文件引用，触发弹窗
2. #NAME?错误：
   • Range(Split(arr(i), ":")(1) & 1) 依赖当前活动工作表，若活动表不是wsOut，会引用错误列
   • 工作表名称未加单引号，导致公式无法识别合法的工作表引用
   • startCell的处理冗余，且未考虑公式引用的正确性

修正后的高效实现代码 #

以下代码解决所有问题，通过数组映射批量处理，满足15次操作需求：

Sub BatchSumIfMatch()
    Dim wsTrans As Worksheet, wsOut As Worksheet
    Dim lastRowTrans As Long, lastRowOut As Long
    Dim colMap As Variant, i As Integer
    Dim critRangeAddr As String, sumRangeAddr As String
    Dim targetCol As Range
    
    ' 绑定工作表
    Set wsTrans = ThisWorkbook.Worksheets("DEL SOURCE_Translator")
    Set wsOut = ThisWorkbook.Worksheets("FID GDMR - Output_2")
    
    ' 获取有效数据最后行（避免空行）
    lastRowTrans = wsTrans.Cells(wsTrans.Rows.Count, "AA").End(xlUp).Row
    lastRowOut = wsOut.Cells(wsOut.Rows.Count, "B").End(xlUp).Row
    
    ' 定义列映射：(wsTrans求和列, wsOut目标列)，可继续添加更多组
    colMap = Array( _
        Array("AG", "AT"), _
        Array("AJ", "BB"), _
        Array("AM", "BJ"), _
        Array("AT", "BR"), _
        Array("AZ", "CA"), _
        Array("BP", "DE"), _
        Array("BW", "DO") _
    )
    
    ' 拼接条件范围地址（用单引号包裹带空格的工作表名称）
    critRangeAddr = "'" & wsTrans.Name & "'!" & wsTrans.Range("AA21:AA" & lastRowTrans).Address
    
    ' 批量处理每一列对
    For i = LBound(colMap) To UBound(colMap)
        ' 拼接求和范围地址
        sumRangeAddr = "'" & wsTrans.Name & "'!" & wsTrans.Range(colMap(i)(0) & "21:" & colMap(i)(0) & lastRowTrans).Address
        ' 定位目标列范围
        Set targetCol = wsOut.Range(colMap(i)(1) & "2:" & colMap(i)(1) & lastRowOut)
        
        ' 用R1C1格式写入公式，自动匹配每行ID
        targetCol.FormulaR1C1 = "=SUMIF(" & critRangeAddr & ",RC2," & sumRangeAddr & ")"
        ' 可选：将公式转为值（不需要保留公式时启用）
        targetCol.Value = targetCol.Value
    Next i
End Sub

优化点 #

1. 处理带空格的工作表名称：用单引号包裹，避免Excel识别为外部文件
2. 精准范围：获取有效数据最后行，避免引用空行或无限范围
3. 高效批量填充：用R1C1公式格式，自动适配每行的ID引用
4. 可扩展性：只需在colMap数组中添加列对，即可实现任意次数的重复操作

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