2種類のシート比較(空白の比較に関して)

Question

同じエクセル内で、新旧2種類のシート(項目順番は全く同じ)を
それぞれのシートのセルを一つずつ比較し変更箇所に黄色をつけるマクロを組みました。
ただ、旧シートのセル情報が空白、新シートのセル情報が入っている場合に色付けが出来ません。
「If Len(OldStr) > 0 Then」この部分で旧シートセルの空白が０とされるのでスルーされるのかなと思っているのですが、どの様に変更すればいいのか色々調べてもよくわからなくなりました。
わかる方教えていただけますでしょうか。

Sub 変更箇所チェック()

'   作業ワークシート
    Dim wksOld As Worksheet
    Dim wksNew As Worksheet

'   古いシートA、新しいシートBとする。
    Set wksOld = Sheets("A")
    Set wksNew = Sheets("b")

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

'   古いワークシートのセルを一個ずつループ
    For Each r In rngOld
        DoEvents
        
        Dim OldStr As String
        Debug.Print (r.Value)
        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関数で２つのセルの内容が等しいかをチェック
            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
　
    

Comments

[meg_]

> 「If Len(OldStr) > 0 Then」この部分で旧シートセルの空白が０とされるのでスルーされるのかなと思っているのですが

そうであれば、その部分を削除して実行してみれば良いのではないでしょうか？ それで上手くいかない場合は他の原因を探しましょう。

[tkt1964]

meg_さん
その発想全然ありませんでした。誠にありがとうございます。

Answer 1

「If Len(OldStr) > 0 Then」この部分で旧シートセルの空白が０とされるのでスルーされるのかなと思っているのですが、どの様に変更すればいいのか色々調べてもよくわからなくなりました。

そこまで分かっていて、そのIf文を削除してみようという発想になぜならないのか、不思議です。

その、If文を削除してみてください。

StrComp("", "xxxx", vbTextCompare)<>0 の結果はTrueです。

---

以下、蛇足です。
一つずつ細かく変数に代入するというのも一つのやり方だと思いますが、
やっていることはシンプルなことですので、使用する変数は最低限にしたほうがコードが読みやすいと思います。
自分がコーディングするなら下記のような感じになります。

Sub 変更箇所チェック()
    Dim wksOld As Worksheet
    Dim wksNew As Worksheet

    '   古いシートA、新しいシートBとする。
    Set wksOld = Worksheets("A")
    Set wksNew = Sheets("b")

    '   古いワークシートのセルを一個ずつループ
    Dim r As Range
    For Each r In wksOld.UsedRange
        With wksNew.Range(r.Address)
            If StrComp(r.Text, .Text, vbTextCompare) <> 0 Then
                .Interior.Color = vbYellow    '黄色の定数
            End If
        End With
    Next r
End Sub

Comments

[tkt1964]

hatena19さん

誠にありがとうございます。コードも誠にありがとうございます。

Answer 2

以下のような形になるかと。

        If Len(OldStr) > 0 Then
・・・・・省略・・・・
        Else
            If wksNew.Cells(r.row, r.Column).Value <> "" Then
                wksNew.Cells(r.row, r.Column).Interior.Color = 65535    '黄色の定数
            End If
        End If

Comments

[tkt1964]

tatsu99さん
誠にありがとうございます。