VBA实现多条件SumIfs返回0或报错问题求助

第一段代码（写入公式）的错误与修正 #

错误原因 #

• 错误地将VBA的Range()函数写入Excel单元格公式，Excel原生公式不识别VBA语法
• 字符串拼接逻辑错误，导致生成的公式格式无效
• 未使用绝对引用，下拉公式时条件区域和条件单元格会自动偏移，引发计算错误

修正后的代码 #

Sub WriteSumIfsFormula()
    Dim ws As Worksheet, Lr1 As Long, i As Long
    Set ws = Worksheets("Sheet1")
    
    ' 获取数据区域的最后一行（以A列为准）
    Lr1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    ' 循环写入公式
    For i = 3 To Lr1
        ' 用绝对引用锁定条件区域和条件单元格，避免公式偏移
        ws.Range("I" & i).Formula = "=SUMIFS(B" & i & ":F" & i & ", $B$1:$F$1, $I$1, $B$2:$F$2, $I$2)"
    Next i
End Sub

第二段代码（使用WorksheetFunction）的错误与修正 #

错误原因 #

• 未指定工作表对象，Range和Cells默认引用活动工作表，可能与目标工作表不一致
• WorksheetFunction.SumIfs在无匹配条件时会直接抛出1004运行时错误，容错性差；改用Application.SumIfs会返回错误值（如#N/A），更适合后续处理
• 部分单元格引用未明确绑定目标工作表，存在引用风险

修正后的代码 #

Sub CalculateSumIfsWithVBA()
    Dim ws As Worksheet, Lr1 As Long, i As Long
    Set ws = Worksheets("Sheet1")
    
    Lr1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    For i = 3 To Lr1
        ' 所有Range/Cells都绑定ws对象，使用Application提升容错性
        Dim result As Variant
        result = Application.SumIfs( _
            ws.Range(ws.Cells(i, 2), ws.Cells(i, 6)), ' 求和区域：第i行B-F列（列号2到6）
            ws.Range("B1:F1"), ws.Range("I1"), ' 条件1：B1:F1等于I1
            ws.Range("B2:F2"), ws.Range("I2") ' 条件2：B2:F2等于I2
        )
        ' 无匹配时返回0而非错误值
        ws.Range("I" & i).Value = IIf(IsError(result), 0, result)
    Next i
End Sub

补充优化建议 #

如果数据量较大，建议一次性写入公式而非逐行循环，能大幅提升运行效率：

Sub BatchWriteFormula()
    Dim ws As Worksheet, Lr1 As Long
    Set ws = Worksheets("Sheet1")
    Lr1 = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    
    ' 一次性给I3到I最后一行写入公式
    ws.Range("I3:I" & Lr1).Formula = "=SUMIFS(B3:F3, $B$1:$F$1, $I$1, $B$2:$F$2, $I$2)"
End Sub

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