masato日記

勉強ノート

VBAでExcelワークシートの間違い探しをする(差分ハイライト)

事務仕事でよくなんかのチェックリストをエクセルで作りますよね。
で、チェック項目が完了したり、内容の変更があったりして、どんどん更新されていくわけです。
が、更新箇所を人力で探すのは大変です。
これをVBAで片付けてみましょう。


やり方:
1.ワークシートA、A´を比較
2.ワークシートA、A´でセルを一つずつ比較する
3.二つのセルの中身が異なれば、新しい方のセルを好きな色で塗りつぶす(今回は黄色)

はじめにコード全体です。

Sub 変更箇所チェック()

'   作業ワークシート(シートはお好みで選択する)
    Dim wksOld As Worksheet
    Dim wksNew As Worksheet
'   仮に古いシートが左端(インデックス=1)、新しいシートがその右となり(インデックス=2)にあるとする。
    Set wksOld = ActiveWorkbook.Sheets(1)
    Set wksNew = ActiveWorkbook.Sheets(2)

'   セル参照用のレンジ変数
    Dim r As Range
    Dim rngOld As Range
    Set rngOld = wksOld.UsedRange

'   古いワークシートのセルを一個ずつループ
    For Each r In rngOld
        DoEvents
        
        Dim OldStr As String
        OldStr = r.Value' 古いシートの比較対象セルの中身
        If Len(OldStr) > 0 Then

            'Newシートで比較するセルの行列番号を取得し、
            'Oldシートにある同じ位置のセルを参照する
            Dim row As Long, col As Long
            row = r.row
            col = r.column
           
            Dim rngNew As Range
            Set rngNew = wksNew.Cells(row, col)
            Dim NewStr As String
            NewStr = rngNew.Value'新しいワークシートの比較対象セルの中身

            'StrComp関数で2つのセルの内容が等しいかをチェック
            '等しいときは返値が0になる
            '参考サイト:http://www.239-programing.com/excel-vba/func/func02E.html
            If strcomp(OldStr, NewStr, vbTextCompare) <> 0 Then
                rngNew.Interior.Color = 65535'黄色の定数
            End If
        End If
    Next r

'   後片付け
    Set wksNew = Nothing
    Set wksOld = Nothing
    Set rngOld = Nothing
    Set rngNew = Nothing

End Sub

中身

まず、準備から。ワークシートを2つ処理したいので、それぞれわかりやすい名前をつけて変数に入れます。

'   作業ワークシート(シートはお好みで選択する)
    Dim wksOld As Worksheet
    Dim wksNew As Worksheet
'   仮に古いシートが左端(インデックス=1)、新しいシートがその右となり(インデックス=2)にあるとする。
    Set wksOld = ActiveWorkbook.Sheets(1)
    Set wksNew = ActiveWorkbook.Sheets(2)

仮にwksOld,wksNewとしていますが、もっとわかりよい名前もあると思います。wksはWorksheetですね。この例では、ワークブック上のシートの並び順で古い方、新しい方を分けていますが、これはよくないやり方です(自分で書いておいてなんですが)。なぜなら、シートの順番を変えるだけでコードの動きがおかしくなってしまうからです。ベストプラクティスとしては、ワークシートオブジェクトの名前で指定する方法が推奨されています。この方法なら、並び順に影響されませんし、シート名を変えたって大丈夫です。

次に、実際の比較処理をどうやっていくかをみていきます。

'   セル参照用のレンジ変数
    Dim r As Range
    Dim rngOld As Range
    Set rngOld = wksOld.UsedRange

'   古いワークシートのセルを一個ずつループ
    For Each r In rngOld
        DoEvents
        
        Dim OldStr As String
        OldStr = r.Value' 古いシートの比較対象セルの中身
        If Len(OldStr) > 0 Then

            'Newシートで比較するセルの行列番号を取得し、
            'Oldシートにある同じ位置のセルを参照する
            Dim row As Long, col As Long
            row = r.row
            col = r.column
           
            Dim rngNew As Range
            Set rngNew = wksNew.Cells(row, col)
            Dim NewStr As String
            NewStr = rngNew.Value'新しいワークシートの比較対象セルの中身

            'StrComp関数で2つのセルの内容が等しいかをチェック
            '等しいときは返値が0になる
            '参考サイト:http://www.239-programing.com/excel-vba/func/func02E.html
            If strcomp(OldStr, NewStr, vbTextCompare) <> 0 Then
                rngNew.Interior.Color = 65535'黄色の定数
            End If
        End If
    Next r

あたまで変数を2つ宣言しています(r,rngOld)。前者はループ用の変数、後者は古い方のワークシートの比較範囲をセットするための変数です。
Set rngOld = wksOld.UsedRangeで使用している範囲全体を変数に格納しています。UsedRangeプロパティはこまかい引数を指定することなく、かんたんに範囲を取得できるので便利に使えます。

rngOldには、古い方のシートのセルがたくさんはいってます。for eachループすると順番に参照できます。このときの参照順は左上のセルから列方向に右へ進み、右端まで行ったら1つ下の行に移動。以下これを繰り返します。つまりZ型参照です。

If Len(OldStr) > 0 Then の箇所は、空欄セルを処理から除外するためのものです。参照範囲が増えると、それだけセルの数が増すので、そもそも比較しなくてよいセルをスキップしよう、ということです。これでちょっと速くなります。

で、次にセルの行と列の番号を取得します。新しい方のシートで、その位置のセルを参照するためです。それがこの部分。

Dim rngNew As Range
Set rngNew = wksNew.Cells(row, col)
Dim NewStr As String
NewStr = rngNew.Value'新しいワークシートの比較対象セルの中身

rngNewにさっき見た古いワークシートのセル位置にある新しい方のワークシートのセルを入れます。




注意:比較するワークシートのどちらかで列や行がずれてると、セルの位置が変わって関係ないセルと比較してしまい、失敗します。