一、整体思路 #

咱们分两步搞定这个需求：

1. 做个可点击的按钮，触发宏来选择并导入两个目标文件到当前工作簿的新工作表
2. 编写对比逻辑，把两个导入工作表的内容差异标记出来

二、步骤1：创建按钮并绑定宏 #

• 打开你的宏工作簿，点击【开发工具】→【插入】→ 选【按钮（表单控件）】
• 在工作表上拖动画出按钮，弹出“指定宏”窗口时，点【新建】进入VBA编辑器

三、核心VBA代码实现 #

3.1 文件选择与导入模块 #

把下面的代码粘贴到新建的模块里，它会帮你选两个文件，分别导入到当前工作簿的新工作表：

Sub SelectAndImportTwoFiles()
    Dim filePaths As Variant
    Dim wbSource As Workbook
    Dim wsTarget As Worksheet
    Dim i As Integer
    
    ' 允许选择2个Excel文件
    filePaths = Application.GetOpenFilename( _
        FileFilter:="Excel文件 (*.xlsx;*.xls;*.xlsm), *.xlsx;*.xls;*.xlsm", _
        Title:="请选择需要对比的两个文件", _
        MultiSelect:=True)
    
    ' 判断是否选择了文件
    If IsArray(filePaths) Then
        ' 确保只选了2个文件
        If UBound(filePaths) = 2 Then
            For i = LBound(filePaths) To UBound(filePaths)
                ' 后台静默打开源文件（只读模式，避免修改源文件）
                Set wbSource = Workbooks.Open(filePaths(i), ReadOnly:=True)
                
                ' 在当前工作簿新建工作表，用源文件名命名（去掉后缀）
                Set wsTarget = ThisWorkbook.Sheets.Add(After:=ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count))
                wsTarget.Name = Left(wbSource.Name, InStrRev(wbSource.Name, ".") - 1)
                
                ' 复制源文件第一个工作表的所有内容到新工作表
                wbSource.Sheets(1).UsedRange.Copy Destination:=wsTarget.Range("A1")
                
                ' 关闭源文件，不保存任何修改
                wbSource.Close SaveChanges:=False
            Next i
            
            MsgBox "两个文件已成功导入！现在可以进行对比操作。", vbInformation
        Else
            MsgBox "请选择且仅选择2个文件进行对比！", vbExclamation
        End If
    Else
        MsgBox "你取消了文件选择操作。", vbInformation
    End If
End Sub

3.2 内容对比模块 #

在同一个模块里添加下面的宏，它会对比最后导入的两个工作表，用红色填充标记差异单元格：

Sub CompareTwoSheets()
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim lastRow As Long, lastCol As Long
    Dim rng As Range, cell As Range
    
    ' 获取最后两个导入的工作表（默认是当前工作簿的最后两个表）
    Set ws1 = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count - 1)
    Set ws2 = ThisWorkbook.Sheets(ThisWorkbook.Sheets.Count)
    
    ' 清除之前的条件格式，避免干扰
    ws1.Cells.FormatConditions.Delete
    ws2.Cells.FormatConditions.Delete
    
    ' 获取两个表的最大行和列（取较大值，确保覆盖所有数据）
    lastRow = Application.Max(ws1.Cells(ws1.Rows.Count, "A").End(xlUp).Row, _
                             ws2.Cells(ws2.Rows.Count, "A").End(xlUp).Row)
    lastCol = Application.Max(ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column, _
                             ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column)
    
    ' 逐个单元格对比，标记差异
    Set rng = ws1.Range(ws1.Cells(1, 1), ws1.Cells(lastRow, lastCol))
    For Each cell In rng
        If cell.Value <> ws2.Cells(cell.Row, cell.Column).Value Then
            ' 差异单元格用红色填充
            cell.Interior.Color = RGB(255, 0, 0)
            ws2.Cells(cell.Row, cell.Column).Interior.Color = RGB(255, 0, 0)
        End If
    Next cell
    
    MsgBox "对比完成！差异单元格已用红色标记。", vbInformation
End Sub

四、使用说明 #

1. 回到Excel界面，右键点击之前创建的按钮，选【指定宏】，选择SelectAndImportTwoFiles后确定
2. 点击按钮，选择要对比的两个Excel文件，等待导入完成
3. 可以直接在VBA编辑器里运行CompareTwoSheets宏，或者再创建一个按钮绑定这个宏，方便点击触发
4. 如果你的源文件数据不在第一个工作表，把代码里的wbSource.Sheets(1)改成对应的工作表名称或索引就行

五、额外提示 #

• 如果只需要对比特定列（比如A到E列），可以把lastCol改成固定值（比如5）
• 要是需要更复杂的对比逻辑（比如标记新增/缺失的行、生成差异报告），可以随时调整代码

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