如何在VBA中结合ActiveCell与VLOOKUP公式实现跨表数据累加？

VBA代码实现 #

Sub UpdateAndClear()
    Dim currentRow As Long
    Dim matchKey As Variant
    Dim addAmount As Double
    Dim targetCell As Range
    
    ' 获取当前活动单元格所在行号
    currentRow = ActiveCell.Row
    
    ' 获取当前行A列的匹配关键字
    matchKey = Sheet1.Cells(currentRow, "A").Value
    If IsEmpty(matchKey) Then
        MsgBox "当前行A列不能为空！"
        Exit Sub
    End If
    
    ' 获取当前行C列需累加的数值
    addAmount = Sheet1.Cells(currentRow, "C").Value
    If Not IsNumeric(addAmount) Then
        MsgBox "当前行C列必须为有效数值！"
        Exit Sub
    End If
    
    ' 在Sheet2中匹配对应A列值的记录行
    On Error Resume Next
    Set targetCell = Sheet2.Range("A:A").Find(What:=matchKey, LookIn:=xlValues, LookAt:=xlWhole)
    On Error GoTo 0
    
    If Not targetCell Is Nothing Then
        ' 累加数值到Sheet2的I列
        Sheet2.Cells(targetCell.Row, "I").Value = Sheet2.Cells(targetCell.Row, "I").Value + addAmount
    Else
        MsgBox "Sheet2中未找到匹配A列值的记录！"
        Exit Sub
    End If
    
    ' 清空当前行C、E列（按需求自行调整）
    Sheet1.Cells(currentRow, "C").ClearContents
    Sheet1.Cells(currentRow, "E").ClearContents
End Sub

核心逻辑说明 #

• ActiveCell适配多行：通过ActiveCell.Row直接获取当前操作行的行号，无需为每行单独创建按钮——执行宏时，只要选中目标行的任意单元格即可触发对应行的操作（也可将宏绑定到单个按钮，点击时自动读取当前选中行）。
• 替代工作表VLOOKUP的实现：代码中用Range.Find完成匹配，比直接调用工作表VLOOKUP函数容错性更强，能处理无匹配项的场景。如果坚持使用VLOOKUP逻辑，可替换为以下代码段：

  Dim matchRow As Variant
  matchRow = Application.Match(matchKey, Sheet2.Range("A:A"), 0)
  If Not IsError(matchRow) Then
      Sheet2.Cells(matchRow, "I").Value = Sheet2.Cells(matchRow, "I").Value + addAmount
  End If
  

• 错误防护：加入了对A列空值、C列非数值、无匹配记录的判断，避免代码运行时崩溃。

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