Excelファイルを比較するExcelVBA

経緯

連絡なく資料を更新してくる顧客と出会ったので過去資料と比較したいと思った。

Sub CompareBooksAndOutputDifferences()
    Dim book1Path As String
    Dim book2Path As String
    Dim book1 As Workbook
    Dim book2 As Workbook
    Dim compareSheet As Worksheet
    Dim diffSheet As Worksheet
    Dim compareRange As Range
    Dim diffRow As Long
    Dim sheetName As String
    Dim i As Long, j As Long

    ' 比較するExcelブックのパスを指定
    book1Path = ThisWorkbook.Sheets("比較指定シート").Range("A2").Value
    book2Path = ThisWorkbook.Sheets("比較指定シート").Range("A3").Value

    ' ブックを開く
    Set book1 = Workbooks.Open(book1Path)
    Set book2 = Workbooks.Open(book2Path)

    ' 比較シートを取得
    Set compareSheet = ThisWorkbook.Sheets("比較指定シート")

    ' 差分を出力するシートを作成
    Set diffSheet = ThisWorkbook.Sheets.Add(After:=Sheets(Sheets.Count))
    diffSheet.Name = "差分"

    ' 比較する範囲を取得
    Set compareRange = compareSheet.Range("B2", compareSheet.Cells(compareSheet.Rows.Count, "B").End(xlUp))

    ' 差分を記録するための行を初期化
    diffRow = 2

    ' ブック1とブック2を比較
    For Each cell In compareRange
        If Not IsEmpty(cell) Then
            sheetName = cell.Value
            If SheetExists(book1, sheetName) And SheetExists(book2, sheetName) Then
                If book1.Sheets(sheetName).UsedRange.Rows.Count <> book2.Sheets(sheetName).UsedRange.Rows.Count Or _
                   book1.Sheets(sheetName).UsedRange.Columns.Count <> book2.Sheets(sheetName).UsedRange.Columns.Count Then
                    ' シートの行数または列数が異なる場合、差分として出力
                    diffSheet.Cells(diffRow, 1).Value = sheetName
                    diffSheet.Cells(diffRow, 2).Value = "全体"
                    diffSheet.Cells(diffRow, 3).Value = "全体"
                    diffSheet.Cells(diffRow, 4).Value = "ブック1のシートの行数または列数が異なります"
                    diffSheet.Cells(diffRow, 5).Value = "ブック2のシートの行数または列数が異なります"
                    diffRow = diffRow + 1
                Else
                    ' 行と列の各セルを比較
                    For i = 1 To book1.Sheets(sheetName).UsedRange.Rows.Count
                        For j = 1 To book1.Sheets(sheetName).UsedRange.Columns.Count
                            If book1.Sheets(sheetName).Cells(i, j).Value <> book2.Sheets(sheetName).Cells(i, j).Value Then
                                diffSheet.Cells(diffRow, 1).Value = sheetName
                                diffSheet.Cells(diffRow, 2).Value = i
                                diffSheet.Cells(diffRow, 3).Value = j
                                diffSheet.Cells(diffRow, 4).Value = book1.Sheets(sheetName).Cells(i, j).Value
                                diffSheet.Cells(diffRow, 5).Value = book2.Sheets(sheetName).Cells(i, j).Value
                                diffRow = diffRow + 1
                            End If
                        Next j
                    Next i
                End If
            Else
                MsgBox "シート '" & sheetName & "' がブック1またはブック2に存在しません。", vbCritical
            End If
        End If
    Next cell

    ' ブックを閉じる
    book1.Close False
    book2.Close False

    MsgBox "比較が完了しました。"
End Sub

Function SheetExists(wb As Workbook, sheetName As String) As Boolean
    Dim sheet As Worksheet
    On Error Resume Next
    Set sheet = wb.Sheets(sheetName)
    On Error GoTo 0
    SheetExists = Not sheet Is Nothing
End Function

パッと作り過ぎてまだテストし切れていないがここからブラッシュアップしていけば使えるはず