ブック内の全シート差分検証

二つのワークブック内の全てのシートを比較し、異なるセルの値、数式、表示形式、
フォントの属性、セル背景色、罫線の情報をイミディエイトウィンドウに出力

Sub prcCompareAllSheetsWithFormat()
    ' 機能概要: 二つのワークブック内の全てのシートを比較し、異なるセルの値、数式、表示形式、
    '           フォントの属性、セル背景色、罫線の情報を出力
    ' 引数: なし
    ' 備考: イミディエイトウィンドウに結果を出力

    Dim wb1 As Workbook, wb2 As Workbook
    Dim ws1 As Worksheet, ws2 As Worksheet
    Dim cell1 As Range, cell2 As Range
    Dim strFilePathA As String, strFilePathB As String
    Dim strFileName As String

    ' ファイルのパスとファイル名を設定
    strFilePathA = "C:\FolderA\"
    strFilePathB = "C:\FolderB\"
    strFileName = "FileC.xlsx" ' ここにファイル名を指定

    ' ファイルを開く
    Set wb1 = Workbooks.Open(strFilePathA & strFileName)
    Set wb2 = Workbooks.Open(strFilePathB & strFileName)

    ' 全てのシートを比較
    For Each ws1 In wb1.Sheets
        Set ws2 = wb2.Sheets(ws1.Name)

        ' セルを比較
        For Each cell1 In ws1.UsedRange
            Set cell2 = ws2.Range(cell1.Address)
            If Not IsEqualCells(cell1, cell2) Then
                ' イミディエイトウィンドウに情報を出力
                Debug.Print "Difference found in Sheet " & ws1.Name & " at " & cell1.Address
            End If
        Next cell1
    Next ws1

    ' ファイルを閉じる
    wb1.Close False
    wb2.Close False
End Sub

' セルの値、数式、表示形式、フォントの属性、セル背景色、罫線が等しいか比較する関数
Function IsEqualCells(cell1 As Range, cell2 As Range) As Boolean
    IsEqualCells = True
    ' 値を比較
    If cell1.Value <> cell2.Value Then IsEqualCells = False
    ' 数式を比較
    If cell1.Formula <> cell2.Formula Then IsEqualCells = False
    ' 表示形式を比較
    If cell1.NumberFormat <> cell2.NumberFormat Then IsEqualCells = False
    ' フォント名を比較
    If cell1.Font.Name <> cell2.Font.Name Then IsEqualCells = False
    ' フォントサイズを比較
    If cell1.Font.Size <> cell2.Font.Size Then IsEqualCells = False
    ' フォント色を比較
    If cell1.Font.Color <> cell2.Font.Color Then IsEqualCells = False
    ' セル背景色を比較
    If cell1.Interior.Color <> cell2.Interior.Color Then IsEqualCells = False
    ' 罫線を比較
    If Not IsEqualBorders(cell1, cell2) Then IsEqualCells = False
End Function

' 罫線が等しいか比較する関数
Function IsEqualBorders(cell1 As Range, cell2 As Range) As Boolean
    Dim i As Integer
    IsEqualBorders = True
    For i = 1 To 4 ' Excelの罫線は4方向を持つ
        With cell1.Borders(i)
            If .LineStyle <> cell2.Borders(i).LineStyle Or _
               .Weight <> cell2.Borders(i).Weight Or _
               .Color <> cell2.Borders(i).Color Then
                IsEqualBorders = False
                Exit For
            End If
        End With
    Next i
End Function


コメント