求Excel VBA代码实现按指定行列文本匹配计算SUMPRODUCT求和

以下代码可实现不依赖固定单元格地址，通过匹配行、列标识自动求和的需求：

完整代码 #

Sub 动态匹配求和()
    Dim ws As Worksheet
    Dim targetCol As Long
    Dim searchRng As Range
    Dim cell As Range
    Dim sumResult As Double
    ' 目标行标识，可根据实际需求增删修改
    Dim targetRows As Variant
    targetRows = Array("ABC TOT", "EFG TOT", "XYZ TOT")
    
    ' 绑定操作工作表，如需指定工作表可改为 Set ws = Sheets("你的工作表名")
    Set ws = ActiveSheet
    
    ' 定位表头为"THIS TITLE"的目标列
    Set searchRng = ws.Rows(1).Find(What:="THIS TITLE", LookIn:=xlValues, LookAt:=xlWhole)
    If searchRng Is Nothing Then
        MsgBox "未找到表头为【THIS TITLE】的列，请检查表头配置", vbExclamation
        Exit Sub
    End If
    targetCol = searchRng.Column
    
    ' 遍历A列匹配目标行，累加交叉位置数值
    sumResult = 0
    For Each cell In ws.Range("A:A").SpecialCells(xlCellTypeConstants)
        If Not IsError(Application.Match(cell.Value, targetRows, 0)) Then
            sumResult = sumResult + Val(ws.Cells(cell.Row, targetCol).Value)
        End If
    Next cell
    
    ' 结果输出位置，可按需修改为其他单元格
    ws.Range("K1").Value = sumResult
    MsgBox "计算完成，最终求和结果为：" & sumResult, vbInformation
End Sub

使用说明 #

• 代码自动识别THIS TITLE所在列和三个汇总行的位置，不管行列怎么变动都能匹配到正确的单元格
• 非数值内容会自动按0计算，不会触发报错
• 结果默认输出到当前工作表的K1单元格，你可以修改代码里ws.Range("K1")的参数调整输出位置
• 如果后续需要修改目标行标识或者匹配的表头名称，直接修改代码里targetRows数组和Find方法的What参数即可

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