Excel 比较两本工作簿

我想比较两本工作簿之间的变化。
数据看起来有点像这样

工作手册1：

Column1     Column 2     Column 3   
Nissan      Micra        Red      
Honda       CRV          Grey      
Honda       Accord       Grey 

工作手册2：

Column 1     Column 2     Column 3  
Nissan       Micra         Red  
Honda        CRV           White  
Honda        CRV           Grey

当我遍历每一行时，我想识别列与列之间的更改

---

例如，代码应该识别/输出在第2行中，第2列和第3列之间有变化，在第3行中，第1列和第2列之间有变化。

现在回答您的问题有点困难，因为您没有给出任何初步代码或您希望如何进行比较的详细信息（通过MsgBox、Debug.Print、生成.xlsx或.txt文件等）

幸运的是，这看起来类似于我过去必须做的事情，因此我有一个代码示例与您分享，可以帮助您开始

要运行该示例，只需将下面的代码（1个子过程和2个函数）粘贴到模块中，然后运行子过程

Public Sub CompareWorkbooks()
'PURPOSE: Compare the sheets with the same name in two workbooks to make sure all the values are the same.

    'Select the 2 files manually
    Dim WbName1 As String, WbName2 As String
    WbName1 = UserSelectWorkbook
    WbName2 = UserSelectWorkbook

    'Open the 2 files if they are not open
    Dim FullFileName As String
    Dim temp() As String
    Dim FileName As String

    FullFileName = WbName1
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    Dim wb1 As Workbook, wb2 As Workbook

    If IsWorkbookOpen(FileName) = False Then
        Set wb1 = Workbooks.Open(FullFileName)
    Else
        Set wb1 = Workbooks(FileName)
    End If

    FullFileName = WbName2
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    If IsWorkbookOpen(FileName) = False Then
        Set wb2 = Workbooks.Open(FullFileName)
    Else
        Set wb2 = Workbooks(FileName)
    End If

    'Compare the 2 files
    Dim DifferenceFoundInWorkbook As Boolean

    Dim ws1 As Worksheet, ws2 As Worksheet
    For Each ws1 In wb1.Worksheets
        For Each ws2 In wb2.Worksheets

            If ws1.Name = ws2.Name Then

                Dim Range1 As Range, Range2 As Range
                Set Range1 = ws1.UsedRange
                Set Range2 = ws2.UsedRange

                Dim DifferenceFoundWithinSheets As Boolean
                DifferenceFoundWithinSheets = False 'Reset

                Dim CellNumber As Long
                CellNumber = 0 'Reset

                Dim c As Range
                For Each c In Range1

                    CellNumber = CellNumber + 1
                    If c.Value2 <> Range2.Cells(CellNumber).Value2 Then

                        Dim DoContinue As Variant
                        DoContinue = MsgBox("Different values in " & vbNewLine & _
                        "[" & wb1.Name & "]" & ws1.Name & "!" & c.Address & " (""" & Range1.Cells(CellNumber).Value2 & """)" & vbNewLine & _
                        "[" & wb2.Name & "]" & ws2.Name & "!" & c.Address & " (""" & Range2.Cells(CellNumber).Value2 & """)" & vbNewLine & vbNewLine & _
                        "Continue searching?", _
                        vbYesNoCancel, "Workbook Comparison")

                        DifferenceFoundWithinSheets = True
                        DifferenceFoundInWorkbook = True

                        Select Case DoContinue
                        Case Is = vbYes: 'Let the comparison continue
                        Case Is = vbNo: Exit Sub
                        Case Is = vbCancel: Exit Sub
                        Case Else: Exit Sub 'For when the user press the X in the top righ corner.
                        End Select

                    End If
                Next c

                If Not DifferenceFoundWithinSheets Then
                    MsgBox "No difference found between the 2 worksheets with name " & ws1.Name
                End If

            End If

        Next ws2
    Next ws1


    If Not DifferenceFoundInWorkbook Then
        MsgBox "No difference found between the 2 workbooks."
    End If

End Sub

Public Function UserSelectWorkbook() As String
'PURPOSE: Allows to select one workbook using the usual window.
'SOURCE: https://excelmacromastery.com/excel-vba-workbook/

    On Error GoTo ErrorHandler

    Dim FD As FileDialog
    Set FD = Application.FileDialog(msoFileDialogFilePicker)

    ' Open the file dialog
    With FD
        ' Set Dialog Title
        .Title = "Please Select File"

        ' Add filter
        .Filters.Add "Excel Files", "*.xls;*.xlsx;*.xlsm;*.xlsb;*.csv"

        ' Allow selection of one file only
        .AllowMultiSelect = False

        ' Display dialog
        .Show

        If FD.SelectedItems.Count <> 0 Then
            UserSelectWorkbook = FD.SelectedItems(1)
        Else
            MsgBox "Selecting a file has been cancelled. "
            UserSelectWorkbook = vbNullString
        End If
    End With

CleanUp:
    Set FD = Nothing
    Exit Function
ErrorHandler:
    MsgBox "Error: " & Err.Description
    GoTo CleanUp

End Function

Public Function IsWorkbookOpen(ByVal FullFileName As String) As Boolean

    Dim wb As Workbook
    Dim ErrNb As Long

    On Error Resume Next
    Set wb = Workbooks(FullFileName)
    ErrNb = Err.Number
    On Error GoTo 0

    Select Case ErrNb
    Case 0:         IsWorkbookOpen = True
    Case Else:      IsWorkbookOpen = False
    End Select

End Function

---

如何将所有更改粘贴到新的工作表中？

Public Sub CompareWorkbooks()
'PURPOSE: Compare the sheets with the same name in two workbooks and generate a summary in a new workbook.

    'Select the 2 files manually
    Dim WbName1 As String, WbName2 As String
    WbName1 = UserSelectWorkbook
    WbName2 = UserSelectWorkbook

    'Open the 2 files if they are not open
    Dim FullFileName As String
    Dim temp() As String
    Dim FileName As String

    FullFileName = WbName1
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    Dim wb1 As Workbook, wb2 As Workbook

    If IsWorkbookOpen(FileName) = False Then
        Set wb1 = Workbooks.Open(FullFileName)
    Else
        Set wb1 = Workbooks(FileName)
    End If

    FullFileName = WbName2
    temp = Split(FullFileName, "\")
    FileName = temp(UBound(temp))

    If IsWorkbookOpen(FileName) = False Then
        Set wb2 = Workbooks.Open(FullFileName)
    Else
        Set wb2 = Workbooks(FileName)
    End If

    'Compare the 2 files
    Dim DifferenceFoundInWorkbook As Boolean

    Dim ws1 As Worksheet, ws2 As Worksheet
    For Each ws1 In wb1.Worksheets
        For Each ws2 In wb2.Worksheets

            If ws1.Name = ws2.Name Then

                Dim Range1 As Range, Range2 As Range
                Set Range1 = ws1.UsedRange
                Set Range2 = ws2.UsedRange

                Dim DifferenceFoundWithinSheets As Boolean
                DifferenceFoundWithinSheets = False 'Reset

                Dim CellNumber As Long
                CellNumber = 0 'Reset

                Dim c As Range
                For Each c In Range1

                    CellNumber = CellNumber + 1
                    If c.Value2 <> Range2.Cells(CellNumber).Value2 Then

                        Dim Counter As Long

                        Dim wbReport As Workbook
                        If Counter = 0 Then
                            Set wbReport = Workbooks.Add
                        End If

                        Counter = Counter + 1

                        wbReport.ActiveSheet.Cells(Counter, 1).Value2 = "[" & wb1.Name & "]" & ws1.Name & "!" & c.Address & " (""" & Range1.Cells(CellNumber).Value2 & """)"
                        wbReport.ActiveSheet.Cells(Counter, 2).Value2 = "[" & wb2.Name & "]" & ws2.Name & "!" & c.Address & " (""" & Range2.Cells(CellNumber).Value2 & """)"

                        DifferenceFoundInWorkbook = True

                    End If
                Next c

            End If

        Next ws2
    Next ws1


    If Not DifferenceFoundInWorkbook Then
        MsgBox "No difference found between the 2 workbooks."
    End If

End Sub