比较两个工作簿

Question

I'm looking to compare the changes between two workbooks.
The data looks a little like this

Workbook 1:

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

Workbook 2:

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

I want to identify the changes from column to column as I traverse each row.

For example, the code should identify / output that in Row 2, there is a change between Column 2 and Column 3, and in Row 3, a change between Column 1 and Column 2.

Answer 1

It's a little difficult to answer your question as it is right now because you didn't give any preliminary code or details of how you want the comparison to be done (via MsgBox, Debug.Print, generating a .xlsx or .txt file, etc.).

Luckily, this looks similar to something I had to do in the past, so I have a code example to share with you that can help you get started.

To run the example, simply paste the code below (1 sub procedure and 2 functions) in a module and run the sub procedure.

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

This code will give you a MsgBox window for each difference found. You might want to change that to a command that would produce a list of those differences and write them inside a worksheet.

Also note that this macro doesn't have any error handling and isn't optimized to run on very large workbooks.

EDIT:

If you want to generate a report into a new workbook, you could use a different version of the CompareWorkbooks macro:

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