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