求VBA代码实现指定单元格数值累加及按名称分配至目标单元格功能

一、基础累加功能（单目标单元格） #

直接用这段VBA代码就能实现输入值累加至指定单元格的需求：

Sub AddToTotal()
    ' 定义输入单元格和目标总额单元格
    Dim inputCell As Range
    Dim totalCell As Range
    
    ' 替换成你实际的单元格位置和工作表名
    Set inputCell = ThisWorkbook.Sheets("Sheet1").Range("E23")
    Set totalCell = ThisWorkbook.Sheets("Sheet2").Range("B4")
    
    ' 校验输入有效性
    If IsNumeric(inputCell.Value) And inputCell.Value <> "" Then
        ' 执行累加操作
        totalCell.Value = totalCell.Value + inputCell.Value
        ' 清空输入框准备下一次输入
        inputCell.ClearContents
    Else
        MsgBox "请输入有效的数字！"
    End If
End Sub

使用方法： #

1. 打开VBA编辑器（按Alt+F11），插入新模块，把代码粘贴进去
2. 返回Excel界面，通过「开发工具」→「插入」→「按钮（表单控件）」添加按钮，关联这个宏即可

二、按名称分配的进阶功能（多目标单元格） #

如果要给不同人（比如John/Jill）分别累加，只需在基础代码上增加名称匹配逻辑：

假设你在Sheet1的A1单元格做一个下拉框（选项为John、Jill）用来选择目标对象，Sheet2的B4是John的总额、B5是Jill的总额，代码如下：

Sub AddToPersonTotal()
    Dim inputCell As Range
    Dim nameCell As Range
    Dim targetCell As Range
    
    Set inputCell = ThisWorkbook.Sheets("Sheet1").Range("E23")
    Set nameCell = ThisWorkbook.Sheets("Sheet1").Range("A1") ' 选择名称的单元格
    
    ' 根据选择的名称匹配对应的总额单元格
    Select Case nameCell.Value
        Case "John"
            Set targetCell = ThisWorkbook.Sheets("Sheet2").Range("B4")
        Case "Jill"
            Set targetCell = ThisWorkbook.Sheets("Sheet2").Range("B5")
        Case Else
            MsgBox "请选择有效的名称！"
            Exit Sub
    End Select
    
    ' 校验输入并执行累加
    If IsNumeric(inputCell.Value) And inputCell.Value <> "" Then
        targetCell.Value = targetCell.Value + inputCell.Value
        inputCell.ClearContents
    Else
        MsgBox "请输入有效的数字！"
    End If
End Sub

三、你录制的宏问题分析 #

你之前的Macro3有两个致命问题：

1. 硬编码固定值：ActiveCell.FormulaR1C1 = "11"会强制把输入单元格改成11，完全忽略你手动输入的内容，所以每次都是加固定值
2. 覆盖而非累加：用PasteSpecial xlPasteValues是直接替换目标单元格的值，没有做加法运算，自然只会替换不会累加

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