検索値と同じ値か、左右の数字と連続数字なら塗潰す。

質問

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

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

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

〇結果
　M1、F7：41が黄色で塗潰される。
　E10、F10：連続数字（41、42）が赤色で塗潰される。
　K10、L10、M10：連続数字（40、41、42）が赤色で塗潰される。

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

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

回答No.4

watabe007 · ベストアンサー

修正
Sub Test3()
Dim i As Long, myArea As Range
Dim myRang As Range, c As Range

Range("A12:M521").Clear
For i = 1 To Range("O1").Value
Range("A1:M11").Copy Cells(i * 12 + 1, "A")
Set myArea = Cells(i * 12 + 1, "A").Resize(11, 13).SpecialCells(2)
Cells(2, i + 14).Copy Cells(i * 12, "A")
For Each myRang In myArea.Areas
For Each c In myRang.Cells
If Val(c.Value) = Val(Cells(i * 12, "A").Value) Then
c.Interior.Color = vbYellow
If c.Column = myRang.Column Then
If Val(c.Value) + 1 = Val(c.Offset(, 1).Value) And _
Val(c.Offset(, 1).Value) + 1 = Val(c.Offset(, 2).Value) Then
c.Resize(, 3).Interior.Color = vbRed
ElseIf Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Resize(, 2).Interior.Color = vbRed
End If
Else
If Val(c.Offset(, -1).Value) + 1 = Val(c.Value) Then
c.Offset(, -1).Resize(, 2).Interior.Color = vbRed
ElseIf Val(c.Value) + 1 = Val(c.Offset(, 1).Value) And _
Val(c.Value) + 2 = Val(c.Offset(, 2).Value) Then
c.Resize(, 3).Interior.Color = vbRed
ElseIf Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Resize(, 2).Interior.Color = vbRed
End If
End If
End If
Next
Next
Next
End Sub

お礼

素早い修正ありがとうございました。
またよろしくお願いします。

回答No.3

watabe007

>01、11といった、一番左端にある数字の検索結果では、
>01と02が赤くならず、01だけが黄色。
>11、12が赤くならず、11だけが黄色。
修正しました。
Sub Test2()
Dim i As Long, myArea As Range
Dim myRang As Range, c As Range

Range("A12:M521").Clear
For i = 1 To Range("O1").Value
Range("A1:M11").Copy Cells(i * 12 + 1, "A")
Set myArea = Cells(i * 12 + 1, "A").Resize(11, 13).SpecialCells(2)
Cells(2, i + 14).Copy Cells(i * 12, "A")
For Each myRang In myArea.Areas
For Each c In myRang.Cells
If Val(c.Value) = Val(Cells(i * 12, "A").Value) Then
c.Interior.Color = vbYellow
If c.Column = myRang.Column Then
If Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Resize(, 2).Interior.Color = vbRed
End If
Else
If Val(c.Offset(, -1).Value) + 1 = Val(c.Value) And _
Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Offset(, -1).Resize(, 3).Interior.Color = vbRed
ElseIf Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Resize(, 2).Interior.Color = vbRed
End If
End If
End If
Next
Next
Next
End Sub

回答No.2

mt2015

質問とありますが、結局あなたこの問題のどこが解らないのでしょうか？
単にマクロを作ってくれと言っているようにしか見えません。
逆に仕様が良くわからないのでこちらから質問します。

・「検索値欄の検索値も１つコピーする。」と、ありますがどこにコピーするのでしょうか。

・塗りつぶすのは「複写数欄の数だけ、上記４つの5×6のセルを１塊りとして下にコピー」した方？大元のA1:M11のセル？
　＃例題の結果を見る限りではA1:M11のセルの方を塗りつぶしているようですが。

・例題の結果で、E7:F7が赤で塗りつぶされずにF7だけが黄色で塗りつぶされるは何故？

・検索値が41だとして、マスの中に39,40,41,42,43,44と数値があった場合、黄色く塗りつぶすのは40,41,42だけ？それとも39～44全て？

・もしかして何かの問題集の問題ではないですよね？
　＃もし、問題集の問題だとしたら、私なら「(2)複写数欄の数だけ、上記４つの5×6のセルを１塊りとして下にコピーする」と「(3)コピー後に検索値欄の値でコピーした側の４つの5×6のセル内を検索して塗潰す。」を別問題として出題すると思います。

お礼

ご質問ありがとうございます。

＞単にマクロを作ってくれと言っているようにしか見えません。
　例題として挙げた処理をマクロでどうやって作ればいいのかわからないので質問させてもらっています。
＞「検索値欄の検索値も１つコピーする。」と、ありますがどこにコピーするのでしょうか。
　　直下です。複写数の数だけ。
＞・塗りつぶすのは「複写数欄の数だけ、上記４つの5×6のセルを１塊りとして下にコピー」した方？大元のA1:M11のセル？
　コピーした方です。
＞・例題の結果で、E7:F7が赤で塗りつぶされずにF7だけが黄色で塗りつぶされるは何故？
　　回答の間違いです。赤く塗り潰しが正しいです。
＞・検索値が41だとして、マスの中に39,40,41,42,43,44と数値があった場合、黄色く塗りつぶすのは40,41,42だけ？それとも39～44全て？
　　検索値が４１なら、黄色は無しです。赤色は40、41、42です。
＞もしかして何かの問題集の問題ではないですよね？
　そのような事はありません。完全オリジナルです。

回答No.1

watabe007

>(2)検索値の左右が検索値との連続数字なら、検索値とその左右のセルを赤色で塗潰す。
>E10、F10：連続数字（41、42）が赤色で塗潰される。
検索値を含む2連続も含むのですね
Sub Test()
Dim i As Long, myArea As Range
Dim myRang As Range, c As Range

Range("A12:M521").Clear
For i = 1 To Range("O1").Value
Range("A1:M11").Copy Cells(i * 12 + 1, "A")
Set myArea = Cells(i * 12 + 1, "A").Resize(11, 13).SpecialCells(2)
Cells(2, i + 14).Copy Cells(i * 12, "A")
For Each myRang In myArea.Areas
For Each c In myRang.Cells
If Val(c.Value) = Val(Cells(i * 12, "A").Value) Then
c.Interior.Color = vbYellow
If c.Column > myRang.Column Then
If Val(c.Offset(, -1)) + 1 = Val(c.Value) And _
Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Offset(, -1).Resize(, 3).Interior.Color = vbRed
ElseIf Val(c.Offset(, -1).Value) + 1 = Val(c.Value) Then
c.Offset(, -1).Resize(, 2).Interior.Color = vbRed
ElseIf Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
c.Resize(, 2).Interior.Color = vbRed
End If
End If
End If
Next
Next
Next
End Sub

補足

いつも大変お世話になっています。
質問の例題とは別に下記を検索対象として、
複写数：43、検索値：1~43にして
教えて頂いたソースを貼りつけて実行したところ、
01、11といった、一番左端にある数字の検索結果では、
01と02が赤くならず、01だけが黄色。
11、12が赤くならず、11だけが黄色。

どこが悪いのでしょうか？

〇検索対象
06　11　23　27　32　42　　04　09　20　24　38　39
08　16　19　31　35　42　　11　12　13　21　23　38
01　03　10　21　26　34　　07　17　22　25　36　40
05　13　29　35　37　41　　04　10　22　29　30　32
07　14　15　18　33　39　　02　15　17　20　30　34

06　24　26　35　37　41　　08　18　23　27　42　43
01　02　09　14　31　41　　07　08　17　19　40　41
03　12　16　18　23　30　　05　06　12　13　33　37
03　10　24　29　30　40　　08　13　18　24　30　32
01　02　09　19　22　42　　03　34　37　38　41　43

〇複写数：43
〇検索値：１~43