Excel VBA选择xlsm文件匹配行后复制指定单元格值到当前工作簿

核心逻辑 #

点击绑定宏的按钮后自动完成全流程操作，全程后台运行无多余弹窗，仅粘贴数值不破坏主表原有格式。

操作流程拆解 #

• 调用文件选择窗口，仅筛选.xlsm格式的宏启用工作簿，支持取消操作
• 只读方式后台打开选中的源文件，操作完成后自动关闭，不会修改源文件内容
• 提取源文件T2、U2单元格的值，按主表B列（0000格式）、C列（00格式）的格式要求转换后遍历匹配，定位主表对应目标行，无匹配结果时弹出提示
• 按映射规则写入数值：源文件V2:X2写入目标行D:F列，源文件AC2:AI2写入目标行K:P列

完整VBA代码 #

Sub 汇总外部表数据()
    Dim sourcePath As Variant
    Dim sourceWb As Workbook
    Dim mainWs As Worksheet
    Dim matchKeyB As String, matchKeyC As String
    Dim targetRow As Long, lastRow As Long, i As Long
    
    ' 绑定主工作表，如需固定指定工作表可替换为 Set mainWs = ThisWorkbook.Sheets("你的主表名称")
    Set mainWs = ThisWorkbook.ActiveSheet
    
    ' 弹出文件选择框
    sourcePath = Application.GetOpenFilename( _
        FileFilter:="Excel宏启用工作簿 (*.xlsm), *.xlsm", _
        Title:="选择待提取数据的源文件")
    If sourcePath = False Then
        MsgBox "未选择文件，操作已取消", vbInformation
        Exit Sub
    End If
    
    ' 关闭屏幕更新、系统弹窗提升运行效率
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    
    On Error GoTo ErrorDeal
    
    ' 只读打开源文件
    Set sourceWb = Workbooks.Open(Filename:=sourcePath, ReadOnly:=True)
    
    ' 提取匹配关键字，统一格式避免数值/文本格式不匹配导致定位失败
    ' 注意：如果源数据不在第一个工作表，将Sheets(1)改为对应表名，例如Sheets("数据表")
    matchKeyB = Format(sourceWb.Sheets(1).Range("T2").Value, "0000")
    matchKeyC = Format(sourceWb.Sheets(1).Range("U2").Value, "00")
    
    ' 遍历主表B列定位匹配行
    lastRow = mainWs.Cells(mainWs.Rows.Count, "B").End(xlUp).Row
    targetRow = 0
    For i = 2 To lastRow ' 假设主表表头在第1行，数据从第2行开始，可根据实际情况调整起始行
        If Format(mainWs.Cells(i, "B").Value, "0000") = matchKeyB And _
           Format(mainWs.Cells(i, "C").Value, "00") = matchKeyC Then
            targetRow = i
            Exit For
        End If
    Next i
    
    If targetRow = 0 Then
        MsgBox "未找到匹配行，匹配信息：" & vbCrLf & _
               "B列匹配值：" & matchKeyB & vbCrLf & _
               "C列匹配值：" & matchKeyC, vbExclamation
        GoTo ClearRes
    End If
    
    ' 按规则写入数值
    mainWs.Range("D" & targetRow & ":F" & targetRow).Value = sourceWb.Sheets(1).Range("V2:X2").Value
    mainWs.Range("K" & targetRow & ":P" & targetRow).Value = sourceWb.Sheets(1).Range("AC2:AI2").Value
    
    MsgBox "数据写入完成，已更新主表第" & targetRow & "行", vbInformation

ClearRes:
    ' 关闭源文件，恢复系统设置
    If Not sourceWb Is Nothing Then sourceWb.Close SaveChanges:=False
    Application.ScreenUpdating = True
    Application.DisplayAlerts = True
    Exit Sub

ErrorDeal:
    MsgBox "运行出错：" & Err.Description, vbCritical
    Resume ClearRes
End Sub

使用注意事项 #

• 代码默认读取源文件第一个工作表的数据，如果源文件数据存放在指定名称的工作表，将代码中所有sourceWb.Sheets(1)替换为sourceWb.Sheets("你的源数据表名称")即可
• 如果主表表头不在第1行，修改遍历循环的起始行号For i = 2 To lastRow中的2为实际数据起始行
• 请核对列范围匹配：源文件AC2:AI2共7列，主表K:P共6列，如果是列范围笔误，直接修改代码中对应的单元格区域地址即可
• 宏按钮绑定方法：在主表插入按钮控件后，右键选择「指定宏」，选中汇总外部表数据即可完成绑定

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