４つのセルを１つの塊り（マス）と捉えて塗潰す方法２

質問

どなたかご存知でしたら回答をよろしくお願いします。
【質問】
下図の様に、a～ｎ、１～１０の合計１４０個のセルに数字が１～９９迄の重複有りで
入っています。a1,a2,b1,b2の４つのセルで１つのマスとみなすと、
140個のセルは縦：５マス、横：７マスの合計３５マスとなります。
この条件で、検索値欄に１つ数字を入れたら、
一致した数字が入っているマス（４つのセルの集合）を塗潰すにはどうすればよいですか？
具体的には、１つのマスに一致した数字が２個以上重複している場合は、赤く塗り潰す。
１個の場合は黄色く塗り潰す事がしたいです。

〇例題
　a　b　c　d　e　f　g　h　i　j　k　l　m　n
1 02 05 08 09 14 13 15 16 17 28 22 32 33 37
2 03 03 05 14 13 28 99 31 23 32 31 36 32 37
3 05 01 07 06 15 07 20 08 26 12 27 19 32 37
4 04 03 08 10 10 14 12 17 24 18 30 22 37 24
5 08 01 13 02 16 04 25 09 28 15 34 24 36 34
6 01 06 05 12 18 14 22 19 23 30 26 35 28 36
7 02 03 04 11 06 16 20 21 25 26 29 27 31 29
8 07 07 08 10 09 14 17 15 18 21 19 26 20 34
9 01 02 10 04 11 05 18 13 27 20 28 33 30 34
10 12 11 16 14 19 24 24 25 27 26 33 32 35 35

検索値:07

【結果】
検索値に07を入れたら、下記の３マス（12セル）が塗潰される。
c3,d3,c4,d4 ・・・　1個一致なので、黄色で塗潰される。
e3,f3,e4,f4　・・・　1個一致なので、黄色で塗潰される。
a7,b7,a8,b8　 ・・・2個一致なので、赤色で塗潰される。

〇注意事項
　・使用するエクセルは２０１０です。
　・１マス＝４セルです。※a1,a2,b1,b2で１マスです。
　・セルに入っている数字はランダムで、同じ数字の重複は35マス（140セル）全体で
　　４個迄です（１つのマスに４個入る事も有るし、４つのマスに１個ずつ入る事も
　　あります。）
　・検索値欄に入力できる数字は１～９９迄の１つです。
　・セルの数字は表示上、２桁で表しています。（例：１ではなく０１）

以上、よろしくお願いします。

回答No.1

watabe007 · ベストアンサー

>一致した数字が２個以上重複している場合は、赤く塗り潰す。
Sub Test4()
　　Dim fnd As Range, R As Boolean, C As Boolean
　　Dim adr As String
　　Dim keyWord As String

　　keyWord = Range("P1").Value
　　Range("A1:N10").Interior.Color = xlNone
　　Set fnd = Range("A1:N10").Find(What:=keyWord, LookIn:=xlValues, _
　　　　LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=True)
　　If fnd Is Nothing Then
　　　　MsgBox keyWord & " は見つかりませんでした。", 48
　　　　Exit Sub
　　End If
　　adr = fnd.Address
　　Do
　　　　R = fnd.Row Mod 2 = 0
　　　　C = fnd.Column Mod 2 = 0
　　　　With fnd.Offset(R, C).Resize(2, 2).Interior
　　　　　　If .Color = vbYellow Then
　　　　　　　　.Color = vbRed
　　　　　　Else
　　　　　　　　.Color = vbYellow
　　　　　　End If
　　　　End With
　　　　Set fnd = Range("A1:N10").FindNext(fnd)
　　Loop While adr <> fnd.Address
End Sub

お礼

昨日に続き、ご回答頂きありがとうございます。
早速、やってみたところ、重複数字のある塊り部分が
赤くなっている事が確認できました。
また、質問を見かけたら回答頂けると助かります。