対象セルに色を付ける

Question

A2からA3395にメッシュコード（8桁の数字）が入っています。また、D2からCO101の範囲に
メッシュコードがレイアウトされています。A2からA3395にあるメッシュコードと同じもの
がD2：CO101の範囲にあったらそのセルに色を付けるマクロをさくせいしたいのですが、
一部にしか色がつかず、終わってしまいます。どなたかご教授お願い致します。
下記に作成したコードを示します。

Sub セルに色を付ける()

Dim i As Long
Dim c As Range

For i = 2 To 3395
For Each c In Range("D2:CO101")
        
    If Cells(i, 1).Value = c.Value Then
       c.Select
       
       With Selection.Interior
       .Pattern = xlSolid
       .PatternColorIndex = xlAutomatic
       .Color = 65535
       .TintAndShade = 0
       .PatternTintAndShade = 0
      End With
      End If
    Next c
Next i

End Sub

Answer 1

ちゃんと動きそうですが、二重ループでとても時間がかかりそうです。
途中で「応答なし」になってしまったのかもしれません。
なので、少しアプローチを変えてみました。
以下のコードで一度試してみてください。

Sub セルに色を付ける改()
    Dim dic As Object
    Set dic = CreateObject("Scripting.Dictionary")
    
    Dim i As Long
    For i = 2 To 3395
        dic(Cells(i, 1).Value) = i
    Next i
    
    Dim rng As Range, arr As Variant
    Set rng = Range("D2:CO101")
    arr = rng.Value
    
    Dim r As Long, c As Long
    For r = 1 To UBound(arr, 1)
    For c = 1 To UBound(arr, 2)
        If dic.Exists(arr(r, c)) Then
            With rng.Cells(r, c).Interior
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .Color = 65535
                .TintAndShade = 0
                .PatternTintAndShade = 0
            End With
        End If
    Next c, r
End Sub

Comments

[ishiro]

早速のご連絡ありがとうございます。試してみました。、処理スピードは上がったのですが、やはり
一部分しか色が付きません。

[jinoji]

色がついた一部分というのは、元のコードのときと同じですか？

色がつくはずなのにつかないセルの値を、イミディエイトウィンドウで確認してみては？
たとえばG7セルはA10セルと一致しているから色がつくはず、という場合に
イミディエイトウィンドウで
?Range("A10").Value = Range("G7").Value, Range("A10").Value, Range("G7").Value
と入力したらどうなりますか？

[ishiro]

ご返信ありがとうございます。
>色がついた一部分というのは、元のコードのときと同じですか？ → 同じです。
>イミディエイトウィンドウ → 色がついたところは True、つかないところは False になりました。
引き続きよろしくお願いいたします。

[jinoji]

Falseとなるなら、その後ろに表示された二つのメッシュコードは異なるはずです。

?Range("A10").Value - Range("G7").Value
としたらどうなりますか？

[ishiro]

0を取得しました。

[jinoji]

?Format(Range("A10").Value,"00000000") = Format(Range("G7").Value,"00000000")
としたらどうなりますか？

[ishiro]

０を取得しました。

[ishiro]

失礼しました。同じものを送ってしまいました。
Trueを取得しました。

[jinoji]

それでは、上のコードを2箇所修正して再度試してみてください。

'dic(Cells(i, 1).Value) = i
dic(Format(Cells(i, 1).Value, "00000000")) = i

' If dic.exists(arr(r, c)) Then
If dic.Exists(Format(arr(r, c), "00000000")) Then

[ishiro]

出来ました。ありがとうございます。
2か所の修正の意味を簡単に説明していただけないでしょうか？

[jinoji]

今回のようにセルの値が数値の場合、
比較する２つのセルの書式が、一方は「標準」で他方が「文字列」だとすると、
見た目上は同じでも、.Valueで取得して比較したときには不一致になります。
（数値と文字列を比較することになるからでしょうか。）
色がつかない箇所があるのはそれが原因だと推測しました。
そのため、双方にFormat関数を用いて書式を揃えることでその違いを吸収したということです。

ちなみに、元のコードで .Value の代わりに .Text 同士で比較していたら、
実はうまくいっていた可能性があります。
その場合は、文字列同士の比較になるからです。

[jinoji]

上記を踏まえると、以下のコードのほうが分かりやすいかもしれません。

Sub セルに色を付ける改2()
Dim dic As Object
Set dic = CreateObject("Scripting.Dictionary")

Dim i As Long
For i = 2 To 3395
dic(Cells(i, 1).Text) = i
Next i

Dim c As Range
For Each c In Range("D2:CO101")
If dic.Exists(c.Text) Then
With c.Interior
.Pattern = xlSolid
.PatternColorIndex = xlAutomatic
.Color = 65535
.TintAndShade = 0
.PatternTintAndShade = 0
End With
End If
Next
End Sub

[ishiro]

ご丁寧な説明ありがとうございます。とても参考になりました。