请求编写VBA宏：跨工作表匹配姓氏并复制粘贴总计值

没问题，我帮你写一个逻辑清晰、易维护的VBA宏来实现这个需求。先理清楚核心逻辑：我们要遍历其中一个工作表的姓氏列，和另一表的姓氏做匹配，找到对应项后把指定列的总计值复制到目标位置。我先做个合理的列假设（方便你根据实际情况调整）：

• Sheet1（左侧）：姓氏在A列，需要接收总计值的列是B列
• Sheet2（右侧）：姓氏在D列，待复制的总计值在E列

如果你的列布局不一样，直接修改代码里的列标识就行。

完整VBA代码 #

Sub CopyTotalByLastNameMatch()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow1 As Long, lastRow2 As Long
    Dim i As Long, j As Long
    Dim lastName1 As String, lastName2 As String
    
    ' 绑定两个目标工作表
    Set ws1 = ThisWorkbook.Sheets("Sheet1")
    Set ws2 = ThisWorkbook.Sheets("Sheet2")
    
    ' 获取两表数据区域的最后一行（避免遍历无效空行）
    lastRow1 = ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row
    lastRow2 = ws2.Cells(ws2.Rows.Count, "D").End(xlUp).Row
    
    ' 遍历Sheet1的每一行姓氏（假设第一行是表头，从第二行开始）
    For i = 2 To lastRow1
        lastName1 = Trim(ws1.Cells(i, "A").Value) ' 去除前后空格，避免匹配误差
        
        ' 跳过空的姓氏行
        If lastName1 = "" Then GoTo NextRow
        
        ' 在Sheet2中查找匹配的姓氏
        For j = 2 To lastRow2
            lastName2 = Trim(ws2.Cells(j, "D").Value)
            
            ' 不区分大小写匹配姓氏
            If UCase(lastName1) = UCase(lastName2) Then
                ' 将Sheet2的总计值复制到Sheet1对应行
                ws1.Cells(i, "B").Value = ws2.Cells(j, "E").Value
                Exit For ' 找到匹配就退出内层循环，提升效率
            End If
        Next j
        
NextRow:
    Next i
    
    MsgBox "总计值复制完成！", vbInformation
End Sub

关键细节说明 #

• 不区分大小写匹配：用UCase()把两个姓氏统一转成大写，避免因为大小写差异（比如"Smith"和"smith"）导致匹配失败
• 去除空格处理：Trim()函数清理姓氏前后的空格，防止输入时的误加空格破坏匹配
• 空行跳过：如果Sheet1的姓氏列是空行，直接跳过，减少无效遍历
• 效率优化：找到匹配项后立刻退出内层循环，不用继续遍历Sheet2的剩余行

适配你的实际场景 #

• 如果需要把Sheet1的总计值复制到Sheet2，只需把代码里的赋值语句改成：ws2.Cells(j, "E").Value = ws1.Cells(i, "B").Value，同时调整对应的列标识
• 若你的姓氏/总计列不是假设的A、B、D、E，直接替换代码里的列字母（比如把"A"改成"C"，"D"改成"F"）
• 如果表格没有表头，把循环的起始行从2改成1

使用步骤 #

1. 打开你的Excel文件
2. 按下Alt + F11打开VBA编辑器
3. 插入新模块：右键点击工作簿名称 → 插入 → 模块
4. 粘贴上面的代码
5. 按下F5运行宏，或回到Excel通过「开发工具」选项卡执行

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