【改造】検索値と一緒に出ている隣接数字を知るには2

質問

いつもお世話になっております。
どかたかご存知でしたら回答をお願いします。
ここ最近、同じ様な質問をしておりますが、よろしくお願いします。

◆改造（付け加える）要件・・・下記以外は前回と同じです。
　(3)コピー後に検索値欄の値でコピーした側の４つの5×6のセル内を検索して塗潰す。
　　具体的には、
　(1)検索値と同じ値を見つけたら、黄色でセルを塗潰す。【既存】
　(2)検索値と同じ値で隣接する８方向（上、下、左、右、右下、左下、右上、左上）
　　の数字との差が0か１なら、検索値とそのセルを赤色で塗潰す。【既存】
　(3)検索値と同じ値で隣接する８方向（上、下、左、右、右下、左下、右上、左上）
　　の数字が全て同じなら、青く塗り潰す。【既存】
　(4)検索値と同じ値で隣接する８方向（上、下、左、右、右下、左下、右上、左上）
　　の数字が１ヶ所を除いて全て同じなら、緑色で塗り潰す。【追加】
〇例題
　Ａ　B　C　Ｄ　Ｅ　Ｆ　G　Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　Ｍ
1 01　11　16　26　31　40　　08　15　21　25　30　35
2 02　03　06　17　27　41　　01　11　26　28　31　36
3 04　09　12　19　22　42　　02　03　06　16　17　37
4 05　13　14　23　29　43　　04　09　12　22　27　38
5 07　10　18　20　24　27　　05　13　19　23　29　39
6
7 04　13　16　30　31　33　　05　08　20　22　26　37
8 02　15　17　24　29　34　　01　03　07　18　19　38
9 01　03　07　19　25　35　　04　12　14　16　25　39
10 11　12　14　21　27　36　 10　11　21　23　27　40
11 06　09　10　23　28　37　 06　08　09　20　28　41

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

〇結果
　A1、H2、A9、H8：01が黄色で塗潰される。
　A2、H3、A8　　 ：02が赤色となる筈だが、３ヶ所で出ているので緑色で塗潰す。
　B2、I3、B9、I8　：03が青色で塗潰される。
　 B1、I2、A10　　　：11が緑色で塗潰される。　
〇青色、緑色で塗潰す説明
　A1にある01の隣接数字は小さい順に、02、03、11
　H2にある01の隣接数字は小さい順に、02、03、08、11、15
　A9にある01の隣接数字は小さい順に、02、03、11、12、15
　H8にある01の隣接数字は小さい順に、03、04、05、08、12
　01が見つかった４か所全てに出現している隣接数字は03なので03を青色で塗潰す。
　01が見つかった３か所全てに出現している隣接数字は02と11なので、
　02と11を緑色で塗潰す。
　※02は本来、01の差：１のため赤色となるが、緑色の条件にも当てはまるため最終的に
　緑色で塗潰す。（青色の条件に当てはまった場合も緑色の条件にも当てはまれば最終的に
　緑色で塗潰す。）

　逆に03を検索値とした場合は、
　B2にある03接数字は小さい順に、01、02、04、06、09、11、12、16
　I3にある03隣接数字は小さい順に、01、02、04、06、09、11、12、26
　B9にある03隣接数字は小さい順に、01、02、07、11、12、14、15、17
　I8にある0の隣接数字は小さい順に、01、04、05、07、08、12、14、20
　03が見つかった４か所全てに出現している隣接数字は01、12なので、
　01、12を青色で塗潰す。
　03が見つかった3か所全てに出現している隣接数字は02、04、11、なので、
　02、04、11を緑色で塗潰す。

＊＊＊＊2018/11/21の質問の内容＊＊＊＊
【質問】
例題の様に５×６マスが４つあり、その中を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

SI299792 · ベストアンサー

注文の多い人ですね（笑）。右に２つずれて
複写数；S1
検索値：S2から右へ
になります。
'
Sub Macro1()
'
　　Dim Col As Integer
　　Dim IRange As Range
'
　　Cells.Interior.Pattern = xlNone
　　[A13:Q557].ClearContents
'
　　For Col = 0 To [S1] - 1
　　　　Set IRange = [A1:O11].Offset(Col * 13)
　　　　IRange = [A1:O11].Value
　　　　Level1 IRange, Cells(2, Col + 19)
　　　　Cells(Col * 13 + 1, "P") = "検索値"
　　　　Cells(Col * 13 + 1, "Q") = Cells(2, Col + 19)
　　Next Col
End Sub

　サブルーチンに分けておいてよかった。こんな時に、必要な所だけ載せればいい。
　前の質問拝見しました。このようなやり方もあるのかと思いました。既に作ってしまったので、今更参考にはできませんが。
　質問履歴を非表示にしているのはなぜですか。このような質問が多いなら、表示にしておいた方がいいと思うのですが。無理にとは言いませんが、せめて前の質問の質問番号を載せるぐらいの配慮は欲しいです。

お礼

ワガママ聞いてくださりあがりがとうございます。
ちゃんと動作確認できました。
これがあると無いとではストレス度が違います。（笑）

＞質問履歴を非表示にしているのはなぜですか。このような質問が多いなら、表示にしておいた方がいいと思うのですが。＞無理にとは言いませんが、せめて前の質問の質問番号を載せるぐらいの配慮は欲しいです。

これまで色々質問してきましたが、
ＢＩＧＬＯＢＥからＯＫＷＡＶＥに入る際の”初期設定”は一度もさわった事が無いんです。
初期設定は非表示なんですね。一度、何が変更できるか見てみます。
同じ様な質問を今後するときはなるべく質問番号載せるようにします。

ありがとうございました。

回答No.1

SI299792

※02は本来、01の差：１のため赤色となるが、緑色の条件にも当てはまるため最終的に緑色で塗潰す。
気に入らなので、また勝手な機能をつけました。差が１の場合、緑を明るくします。
今度は、検索値と同じ値が２か所の場合、周りのすべてに何か色が付きます。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Col As Integer
　　Dim IRange As Range
'
　　Cells.Interior.Pattern = xlNone
　　[A13:O557].ClearContents
'
　　For Col = 0 To [Q1] - 1
　　　　Set IRange = [A1:O11].Offset(Col * 13)
　　　　IRange = [A1:O11].Value
　　　　Level1 IRange, Cells(2, Col + 17)
　　Next Col
End Sub
'
Sub Level1(IRange As Range, ByVal Search As Integer)
'
　　Dim Cell1 As Range
　　Dim TableC(43) As Integer
　　Dim Count As Integer
'
　　For Each Cell1 In IRange
'
　　　　If Cell1 = Search Then
　　　　　　Count = Count + 1
　　　　　　Level2 Cell1, TableC(), Search
　　　　　　Cell1.Interior.Color = vbYellow
　　　　End If
　　Next Cell1
'
　　For Each Cell1 In IRange
'
　　　　If Cell1.Interior.Color <> vbBlue Then
　　　　ElseIf TableC(Cell1) = Count - 1 Then
　　　　　　Cell1.Interior.Color = vbGreen
　　　　ElseIf TableC(Cell1) < Count Then
　　　　　　Cell1.Interior.Pattern = xlNone
　　　　End If
'
　　　　If Cell1.Interior.Color <> vbRed Then
　　　　ElseIf TableC(Cell1) = Count - 1 Then
　　　　　　Cell1.Interior.Color = &HFF7F&
　　　　ElseIf TableC(Cell1) = Count Then
　　　　　　Cell1.Interior.Color = vbMagenta
　　　　End If
　　Next Cell1
End Sub
'
Sub Level2(Cell1 As Range, TableC() As Integer, Search As Integer)
'
　　Dim Cell2 As Range
　　Dim TableB(43) As Boolean
　　Dim RowF As Integer
　　Dim ColF As Integer
'
　　RowF = Cell1.Row > 1
　　ColF = Cell1.Column > 1
'
　　For Each Cell2 In Cell1.Offset(RowF, ColF).Resize(2 - RowF, 2 - ColF)
'
　　　　RowF = Val(Cell2)
　　　　If Cell2 < "01" Then
　　　　ElseIf Abs(Cell1 - Cell2) = 1 Then
　　　　　　Cell2.Interior.Color = vbRed
　　　　ElseIf Cell1 <> Cell2 Then
　　　　　　Cell2.Interior.Color = vbBlue
　　　　End If
　　　　TableC(RowF) = TableC(RowF) + 1 + TableB(RowF)
　　　　TableB(RowF) = True
　　Next Cell2
End Sub

問題は前回不具合が出たパターンです。
　Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ G Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　Ｍ
1 01　11　16　26　31　40　 08　15　21　25　30　35
2 01　03　06　17　27　41　 01　11　26　28　31　36
3 04　09　12　19　22　42　 02　03　06　16　17　37
4 05　13　14　23　29　43　 04　09　12　22　27　38
5 01　10　18　20　24　27　 05　13　19　23　29　39
6
7 04　13　16　30　31　33　 05　08　20　22　26　37
8 02　15　17　24　29　34　 01　03　07　18　19　38
9 01　03　07　19　25　35　 04　12　14　16　25　39
10 11　12　14　21　27　36　 10　11　21　23　27　40
11 06　09　10　23　28　37　 06　08　09　20　28　41
検索値が01の場合、03は４つしかないのに緑になります。
これは、B2の03がA1とA2の両方と隣接している為、これを２つと数えるからです。青に塗る時もこのような問題は発生します。
これはこのままでいいのか、それとも１度数えたものを数えなくするのか書いて下さい。

前回、１か月前の質問を聞いた時、
「また、アドレスを載せる方法も無いです。」
と書いてありましたが、質問Noも載せれないのですか？

参考URL：

https://okwave.jp/qa/q9572003.html

補足

いつもお世話になっております。
早速の回答頂きありがとうございます。

＞検索値が01の場合、03は４つしかないのに緑になります。
＞これは、B2の03がA1とA2の両方と隣接している為、これを２つと数えるからです。
＞青に塗る時もこのような問題は発生します。
＞これはこのままでいいのか、それとも１度数えたものを数えなくするのか書いて下さい。
　このままでよいです。
>前回、１か月前の質問を聞いた時、
>「また、アドレスを載せる方法も無いです。」
>と書いてありましたが、質問Noも載せれないのですか？　　

QNo.9560325です。

追加で質問ですが、
複写数の数字はQ1、検索値はＱ２から右に４３個並んでいます。
そして、下に”複写数ー１”の数だけコピーされて検索されますが、
下にスクロールするとどの検索値か判らなくなるので、
下図の様に、コピーされる右側に”検索値”という文字と、
実際に検索値となる数字をその右側に表示するようするにはどのようにすればよいですか？
１個目から右側に”検索値：１”と表示がしたいです。

例）Ｐ１に”検索値”と表示、Ｑ１に検索値の１が入る。
Ａ　Ｂ　Ｃ　Ｄ　Ｅ　Ｆ 　G　 Ｈ　Ｉ　Ｊ　Ｋ　Ｌ　Ｍ　Ｏ　　Ｐ　　Ｑ　Ｒ　　
1 01　11　16　26　31　40　 08　15　21　25　30　35　　　検索値　1