Sub prcCompareSheets()
Dim wbkA As Workbook, wbkB As Workbook
Dim shtA As Worksheet, shtB As Worksheet
Dim rngCell As Range
Dim wbkResult As Workbook
Dim shtResult As Worksheet
Dim lngRow As Long
' ブックの参照設定
Set wbkA = Workbooks("BookA.xlsx") ' 適宜変更してください
Set wbkB = Workbooks("BookB.xlsx") ' 適宜変更してください
Set wbkResult = Workbooks.Add
Set shtResult = wbkResult.Sheets(1)
' 結果出力シートのヘッダー設定
With shtResult
.Cells(1, 1).Value = "シート名"
.Cells(1, 2).Value = "セルアドレス"
.Cells(1, 3).Value = "BookAの値"
.Cells(1, 4).Value = "BookBの値"
End With
lngRow = 2
' 各シートの比較処理
For Each shtA In wbkA.Sheets
Set shtB = wbkB.Sheets(shtA.Name) ' 同じ名前のシートを想定
For Each rngCell In shtA.UsedRange
If rngCell.Value <> shtB.Cells(rngCell.Row, rngCell.Column).Value Then
' 結果の記録
With shtResult
.Cells(lngRow, 1).Value = shtA.Name
.Cells(lngRow, 2).Value = rngCell.Address
.Cells(lngRow, 3).Value = rngCell.Value
.Cells(lngRow, 4).Value = shtB.Cells(rngCell.Row, rngCell.Column).Value
End With
lngRow = lngRow + 1
End If
Next rngCell
Next shtA
' 結果ブックの保存(オプション)
' wbkResult.SaveAs "比較結果.xlsx"
MsgBox "比較が完了しました。", vbInformation
End Sub
コメント