検索値と同じ値か、隣接数字との差が０か１なら塗潰す

質問

どなたかご存知でしたら回答をお願いします。
【質問】
例題の様に５×６マスが４つあり、その中を1~43の数字が重複有りで入っています。
　1つ目の５×６マス：A1~F5
　2つ目の５×６マス：H1~M5
　3つ目の５×６マス：A7~F11
　4つ目の５×６マス：H7~M11
使い方としては、
　(1)複写数欄と検索値欄それぞれに値を入れます。
　(2)複写数欄の数だけ、上記４つの5×6のセルを１塊りとして下にコピーする
　　（最大：43）。
　　検索値欄の検索値も１つコピーする。
　(3)コピー後に検索値欄の値でコピーした側の４つの5×6のセル内を検索して塗潰す。
　　具体的には、
　　(1)検索値と同じ値を見つけたら、黄色でセルを塗潰す。
　　(2)検索値と同じ値で隣接する８方向（上、下、左、右、右下、左下、右上、左上）
　　　　の数字との差が0か１なら、検索値とそのセルを赤色で塗潰す。

〇例題
　 Ａ　B　C　Ｄ　Ｅ　Ｆ　　G　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　Ｍ　
1　06　21　23　36　37　43　　01　08　16　31　35　41
2　07　12　14　23　32 　43 　　06　10　13　20　27　32
3　09　17　20　29　42 　40 　　02　15　18　30　34　38
4　03　05　13　25　27 　41 　　01　09　25　30　42　43
5　04　11　22　28　35 　39 　　11　16　18　24　29　42
6
7　03　17　27　36　40　41 　　07　21　22　23　33　37
8　03　04　08　24　26 　39 　　02　03　07　14　18　38
9　10　12　22　32　37 　42　　05　10　13　40　41　42
10　02　09　25　32　41　42　　07　13　22　40　41　42
11　08　14　23　24　30　39　　03　29　31　40　41　42

複写数：01　※最大1~43の数字が入る。
検索値：41　※最大43個の数字が右に並ぶ。

〇結果
　M1：41が黄色で塗潰される。
　E3、F3、F4　：40、41、42が赤色で塗潰される。
　E7、F7　　　：40、41が赤色で塗潰される。
　 F9、E10、F10：41、42、42が赤色で塗潰される。
　 K9、L9、M9、K10、L10、M10、K11、L11、M11：40、41、42が赤色で塗潰される。

〇注意事項
　・使用するエクセルは2010です。
　・セルの数字は表示上、2桁で表しています。（例：1ではなく01）
　・検索値欄に入力できる数字は最大43個で、1~43迄の数字です。
　・複写数欄に入力できる数字は1~43迄の１つです。

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

回答No.2

watabe007 · ベストアンサー

なんか、前にも有ったような課題ですね
Sub Test()
Dim i As Long, myArea As Range
Dim myRang As Range, c As Range, cc As Range
Dim SV As Long, flg As Boolean

Application.ScreenUpdating = False
'作業行挿入
Rows("1:1").Insert
'作業列挿入
Columns("A:A").Insert
Range("B13:N522").Clear
For i = 1 To Range("P2").Value
Range("B2:N12").Copy Cells(i * 12 + 2, "B")
Set myArea = Cells(i * 12 + 2, "B").Resize(11, 13).SpecialCells(2)
Cells(3, i + 15).Copy Cells(i * 12 + 1, "B")
For Each myRang In myArea.Areas
SV = Val(Cells(i * 12 + 1, "B").Value)
For Each c In myRang.Cells
If Val(c.Value) = SV Then
For Each cc In c.Cells(0, 0).Resize(3, 3)
If cc.Row Mod 6 <> 1 And cc.Column Mod 7 <> 1 _
And c.Address <> cc.Address Then
If Abs(Val(c.Value) - Val(cc.Value)) <= 1 Then
cc.Interior.Color = vbRed
flg = True
End If
End If
Next
If flg = True Then
c.Interior.Color = vbRed
Else
c.Interior.Color = vbYellow
End If
End If
flg = False
Next
Next
Next
'作業行削除
Rows("1:1").Delete
'作業列削除
Columns("A:A").Delete
Application.ScreenUpdating = True
End Sub

回答No.1

imogasi

この質問と同じ質問を先日、出さなかった？なぜダブって質問するの？
条件付き書式でできるように思う。
（先だっての回答はＶＢＡだったかな）
スペースの行（第６列）や列（Ｇ列）を、うるさく言わないなら、
Ａ１２に指定の値４１を入れることにして（私の決めたこと、表外ならどこでもよい、下記式が変わるが）
Ａ１：Ｍ１１を範囲指定しておいて（Ａ１セルがアクチブの状態で＝必須）
式を
=OR(A1=$A$12,A1=$A$12+1,A1=$A$12-1)
塗りつぶしの色を黄色で指定する。
ーー
なぜ質問に「複写」や「検索」ということが、出てくるのかわからなくて、前回答に遅れたが、上記ではだめか？
駄目ならば、その理由を補足して置いたら。