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

中身

まず、準備から。ふたつのワークシートへの参照を簡単にするために、それぞれを変数にします。

    Dim wksOld As Worksheet
    Dim wksNew As Worksheet
    Set wksOld = ActiveWorkbook.Sheets(1)
    Set wksNew = ActiveWorkbook.Sheets(2)

wksOld,wksNewにしてみました。wks=Worksheetです。
ワークシートのインデックス(並び順)で新旧を指定してしまいましたが、順番が変わったら中身がずれてしまいますね。ベストプラクティスとしては、ワークシートオブジェクトの名前で指定する方法が推奨されています。この方法なら、並び順に影響されませんし、シート名を変えたって大丈夫です。
デフォルトでは、左のシートから`Sheet1, Sheet2`というオブジェクト名になっています。オブジェクト名(ワークシートオブジェクト)で変数を作る場合は以下のようにすればOKです。

    Dim wksOld As Worksheet
    Dim wksNew As Worksheet
    Set wksOld = Sheet1
    Set wksNew = Sheet2


次に、比較処理をやってきます。

まずデータが入っている範囲をRange型の変数にします。
ワークシート全体のうちみるべきデータがある場所を絞り込むわけです。

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

`Set rngOld = wksOld.UsedRange`で古い方のシートのデータ範囲を変数に入れています。`UsedRange`プロパティは、シートのなかで使用済みの範囲をRange型で取得できます。列や行数を気にせずかんたんに範囲を取得できるので便利です。これで古い方のシートのデータ入力範囲が指定できました。

そうしたら次は、いよいよセルに入った値を比較していきます。
順番にセルを見ていく必要があるため、先ほどの`rngOld`を`for each`ループで回して個々のセルを参照します。`for each`ループの順番は、左上のセルから列方向に右へ進み、右端まで行ったら1つ下の行に移動します。つまりZ型です。

'   古いワークシートのセルを一個ずつループ
    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

空のセルは見なくてよいので、 `If Len(OldStr) > 0 Then...` という条件分岐でスキップさせます。参照範囲が増えると、それだけセルの数が増すので、そもそも比較しなくてよいセルをスキップしよう、ということです。これでちょっと速くなります。

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

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

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

最後に、古いシートと新しいシートで値が入っているセルの位置がずれていると、ちゃんと比較できません。