VBA

【VBA】変更前のブックと変更後のブックを比較して、変更されたセルの文字色を変更する

市町村から提出された様式を確認する業務で、資料をみると数値が違うことに気づいて訂正することがあります。

「ここ訂正しておいたで～」とメールを送ろうとするも、どこを直したか忘れてしまった。

そんなときに使います。

Sub CompareWbAandB()
' シートAとシートBの内容を比較し、値が違うセルの文字色を変更する

    Application.ScreenUpdating = False
    Dim filePathA As String, filePathB As String
    
    ' 変更前のエクセルを選択するように指示
    MsgBox "変更前のエクセルを選択してください"
    filePathA = Application.GetOpenFilename(FileFilter:="Excelファイル(*.xlsx; *.xls; *.csv), *.xlsx; *.xls; *.csv")
    If filePathA = "" Then Exit Sub
    
    ' 変更後のエクセルを選択するように指示
    MsgBox "変更後のエクセルを選択してください"
    filePathB = Application.GetOpenFilename(FileFilter:="Excelファイル(*.xlsx; *.xls; *.csv), *.xlsx; *.xls; *.csv")
    If filePathB = "" Then Exit Sub

    Dim wbA As Workbook, wbB As Workbook
    Set wbA = Workbooks.Open(filePathA)
    Set wbB = Workbooks.Open(filePathB)
    
    Dim maxRow As Long, maxCol As Long
    Dim row As Long, col As Long
    Dim valA As Variant, valB As Variant

    ' シートの数を確認
    If wbA.Sheets.count <> wbB.Sheets.count Then
        MsgBox "シートの数が異なります。"
        Exit Sub
    End If

    For i = 1 To wbA.Sheets.count
        ' 変更前のエクセルのi番目のシートと変更後のエクセルのi番目のシートについて、行数、列数の大きい方を取得
        ' 簡単にいうと検索範囲を設定している
        maxRow = Application.Max(wbA.Worksheets(i).UsedRange.Rows.count, wbB.Worksheets(i).UsedRange.Rows.count)
        maxCol = Application.Max(wbA.Worksheets(i).UsedRange.Columns.count, wbB.Worksheets(i).UsedRange.Columns.count)

        ' AとBの内容を比較
        For row = 1 To maxRow
            For col = 1 To maxCol
                valA = ""
                valB = ""

                ' AとBのrow行col列の値を取得
                If row <= wbA.Worksheets(i).UsedRange.Rows.count And col <= wbA.Worksheets(i).UsedRange.Columns.count Then
                    valA = wbA.Worksheets(i).Cells(row, col).Value
                End If
                If row <= wbB.Worksheets(i).UsedRange.Rows.count And col <= wbB.Worksheets(i).UsedRange.Columns.count Then
                    valB = wbB.Worksheets(i).Cells(row, col).Value
                End If
                
                ' シートAとBの値が異なる場合、文字色を変更
                If valA <> valB Then
                    wbB.Worksheets(i).Cells(row, col).Font.Color = RGB(255, 0, 0)
                End If
            Next col
        Next row
    Next i

    MsgBox "処理が終了しました"
    wbA.Close SaveChanges:=False
    wbB.Worksheets(1).Activate
    Application.ScreenUpdating = True
End Sub

実行するとファイル選択ダイアログが2回出てきて、変更前のブックと変更後のブックを選択することができます。

変更後のブックの変更箇所は赤字になります。

変更前のブックです。

変更後のブックです。

1番下の過疎対策事業債の数値を変更しました。

実行後はこうなります。

合計も変わるので2か所が赤字になっています。

また通常このブログでは、ファイル選択をするとき独自に作ったFunctionを使っています。

関連記事【VBA】エクセルファイルを読み込んでファイルパスを返すコード

9,10行目にある通り、今回は違った書き方をしています。

この2行を覚えられるのであればこっちでもいいと思います。（私は無理です）

シートの数や順番が違うパターンを放棄する勇気

このコードでは26行目でシートの数が違う場合は処理を止めています。

また、シートの順番が違う場合も考慮していないので、違う場合は真っ赤なシートができあがるでしょう。

回避する方法は色々考えられますが、きっとこのコードを書く3倍もしくは10倍の時間が必要となるでしょう。

私はこのマクロを使う頻度が思ったより高かったり、多くの人に使われる段階になって初めてその処理を実装します。

まず最速で動くコードを書いて、さっさとその仕事を終わらせることが大切な場合は多いです。

ChatGPTさんによる超詳細解説

このVBAスクリプト（Sub CompareWbAandB）は、二つのExcelファイル（ワークブックAとワークブックB）を比較し、異なる値を持つセルの文字色を赤色に変更するためのものです。それぞれのコード行について説明します。

  1. Sub CompareWbAandB()
    • CompareWbAandB という名前のサブプロシージャ（マクロ）の開始を宣言します。
  2. Application.ScreenUpdating = False
    • スクリプト実行中の画面更新をオフにします。これにより、処理速度が向上し、ユーザーインターフェースのちらつきが減ります。
  3. Dim filePathA As String, filePathB As String
    • ファイルパスを保存するための二つの文字列変数 filePathA と filePathB を宣言します。
  4. MsgBox “変更前のエクセルを選択してください”
    • ユーザーにメッセージボックスを表示して、変更前のExcelファイルを選択するよう指示します。
  5. filePathA = Application.GetOpenFilename(FileFilter:=…)
    • ファイル選択ダイアログを表示し、ユーザーが選択した変更前のファイルのパスを filePathA に代入します。
  6. If filePathA = “” Then Exit Sub
    • ファイルが選択されなかった場合（パスが空の場合）、サブプロシージャを終了します。

(変更後のファイルを選択する部分も同様のプロセスを経て filePathB にパスが格納されます。)

  1. Dim wbA As Workbook, wbB As Workbook
    • 二つのワークブックオブジェクト wbA と wbB を宣言します。
  2. Set wbA = Workbooks.Open(filePathA)
    • filePathA で指定されたワークブックを開き、wbA に代入します。
  3. Set wbB = Workbooks.Open(filePathB)
    • filePathB で指定されたワークブックを開き、wbB に代入します。
  4. Dim maxRow As Long, maxCol As Long
    • 最大行数 maxRow と最大列数 maxCol を格納するための変数を宣言します。
  5. Dim row As Long, col As Long
    • ループで使用する行カウンタ row と列カウンタ col を宣言します。
  6. Dim valA As Variant, valB As Variant
    • セルの値を格納するための変数 valA と valB を宣言します。
  7. If wbA.Sheets.count <> wbB.Sheets.count Then
    • ワークブックAとBのシート数が異なる場合、メッセージボックスを表示し、サブプロシージャを終了します。

(以降のコードでは、各ワークブックのシートを順番に比較していきます。)

  1. For i = 1 To wbA.Sheets.count
    • ワークブックAの各シートについてループを開始します。
  2. maxRow = Application.Max(…)
    • ワークブックAとBの各シートにおける最大行数を取得します。
  3. maxCol = Application.Max(…)
    • 同様に、最大列数を取得します。

(以下のコードブロックでは、ワークブックAとBの対応するシートの各セルを比較します。)

  1. For row = 1 To maxRow
    • 各行についてループを開始します。
  2. For col = 1 To maxCol
    • 各列についてループを開始します。
  3. valA = “”, valB = “”
    • 各比較前に valA と valB の値を初期化します。
  4. If row <= wbA.Worksheets(i).UsedRange.Rows.count And col <= wbA.Worksheets(i).UsedRange.Columns.count Then
    • ワークブックAの現在のセルが有効範囲内にあるかをチェックします。
  5. valA = wbA.Worksheets(i).Cells(row, col).Value
    • ワークブックAの現在のセルの値を valA に代入します。

(ワークブックBについても同様の処理を行います。)

  1. If valA <> valB Then
    • ワークブックAとBの現在のセルの値を比較し、異なる場合は次の処理を行います。
  2. wbB.Worksheets(i).Cells(row, col).Font.Color = RGB(255, 0, 0)
    • ワークブックBの対応するセルの文字色を赤色に変更します。

(ループの終了部分では、次の行や列に進みます。)

  1. Next col, Next row, Next i
    • 各ループを終了し、次のイテレーションに進みます。
  2. MsgBox “処理が終了しました”
    • 処理が完了したことをユーザーに通知するメッセージボックスを表示します。
  3. wbA.Close SaveChanges:=False
    • ワークブックAを保存せずに閉じます。
  4. wbB.Worksheets(1).Activate
    • ワークブックBの最初のシートをアクティブにします。
  5. Application.ScreenUpdating = True
    • 画面更新を再び有効にします。

このスクリプトは、ユーザーが指定した二つのワークブックを比較し、値が異なるセルを視覚的に識別しやすくするために文字色を変更する処理を実行します。これは特に、文書の改訂やデータ更新の確認に役立つツールです。

コメントを残す

メールアドレスが公開されることはありません。 ※ が付いている欄は必須項目です

CAPTCHA