関数

Sub CompareEntireWorkbooks()
    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell1 As Range, cell2 As Range
    Dim maxRow As Long, maxCol As Long
    Dim i As Long, j As Long
    Dim file1 As String, file2 As String
    Dim sheetMatched As Boolean

    ' 1つ目のブックを選択
    file1 = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", , "1つ目のブックを選択してください")
    If file1 = "False" Then
        MsgBox "1つ目のファイル選択がキャンセルされました。", vbExclamation
        Exit Sub
    End If
    Set wb1 = Workbooks.Open(file1)

    ' 2つ目のブックを選択
    file2 = Application.GetOpenFilename("Excel Files (*.xls; *.xlsx; *.xlsm), *.xls; *.xlsx; *.xlsm", , "2つ目のブックを選択してください")
    If file2 = "False" Then
        MsgBox "2つ目のファイル選択がキャンセルされました。", vbExclamation
        wb1.Close False
        Exit Sub
    End If
    Set wb2 = Workbooks.Open(file2)

    ' シートを一括で比較
    For Each ws1 In wb1.Sheets
        sheetMatched = False

        ' 比較先ブックで同名のシートを検索
        For Each ws2 In wb2.Sheets
            If ws1.Name = ws2.Name Then
                sheetMatched = True

                ' 比較範囲を決定（行数と列数）
                maxRow = Application.WorksheetFunction.Max(ws1.Cells(ws1.Rows.Count, 1).End(xlUp).Row, _
                                                           ws2.Cells(ws2.Rows.Count, 1).End(xlUp).Row)
                maxCol = Application.WorksheetFunction.Max(ws1.Cells(1, ws1.Columns.Count).End(xlToLeft).Column, _
                                                           ws2.Cells(1, ws2.Columns.Count).End(xlToLeft).Column)

                ' セルごとに差分比較
                For i = 1 To maxRow
                    For j = 1 To maxCol
                        Set cell1 = ws1.Cells(i, j)
                        Set cell2 = ws2.Cells(i, j)

                        If cell1.Value <> cell2.Value Then
                            ' 差分があるセルをハイライト
                            cell1.Interior.Color = RGB(255, 0, 0) ' 比較元シートを赤色
                            cell2.Interior.Color = RGB(255, 255, 0) ' 比較先シートを黄色
                        End If
                    Next j
                Next i

                Exit For
            End If
        Next ws2

        ' シートが見つからない場合の通知
        If Not sheetMatched Then
            MsgBox "比較元のシート '" & ws1.Name & "' に対応するシートが比較先ブックにありません。", vbExclamation
        End If
    Next ws1

    MsgBox "ブック全体の比較が完了しました！", vbInformation

    ' ファイルを閉じるか確認
    If MsgBox("ファイルを閉じますか？", vbYesNo) = vbYes Then
        wb1.Close False
        wb2.Close False
    End If
End Sub