2つのブックの全セルを比較→異なっている値を出力する

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

コメント