値が入るセル全体を下にコピーした後に検索する方法

質問

どなたかご存知でしたら回答をよろしくお願いします。
【質問】
下図の様に、a～ｎ、1～10の合計140個のセルに数字が1～99迄の重複有りで
入っています。a1,a2,b1,b2の４つのセルで１つのマスとみなすと、
140個のセルは縦：5マス、横：7マスの合計35マスとなります。
使い方としては、
　(1)複写数欄と検索値欄それぞれに値を入れます。
　(2)複写数欄の数だけ、a1～n10の140個のセルを１塊りとして下にコピーする。
　　検索値欄の検索値も１つコピーする。
　(3)コピー後に検索値欄の値でコピーした側のマス（4つのセルの集合）を塗潰す。
　　具体的には、
　　　(1)１つのマスに一致した数字が１個の場合は黄色く塗り潰す。
　　　(2)１つのマスに一致した数字が２個の場合は赤く塗り潰す。
　　　(3)１つのマスに一致した数字が３個の場合は緑色で塗り潰す。
　　　(4)１つのマスに一致した数字が４個の場合は青色で塗潰す。

〇例題
　a　b　c　d　e　f　g　h　i　j　k　l　m　n
1 02 05 07 07 14 13 15 16 17 28 22 32 33 37
2 03 03 07 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 07 07 10 04 11 05 18 13 27 20 28 33 30 34
10 07 07 16 14 19 24 24 25 27 26 33 32 35 35

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

【結果】
検索値：07　※上記、検索値の左から１つずつ値を取得して下記のセルを検索する。
02 05 07 07 14 13 15 16 17 28 22 32 33 37　　　　
03 03 07 14 13 28 99 31 23 32 31 36 32 37
05 01 07 06 15 07 20 08 26 12 27 19 32 37
04 03 08 10 10 14 12 17 24 18 30 22 37 24
08 01 13 02 16 04 25 09 28 15 34 24 36 34
01 06 05 12 18 14 22 19 23 30 26 35 28 36
02 03 04 11 06 16 20 21 25 26 29 27 31 29
07 07 08 10 09 14 17 15 18 21 19 26 20 34
07 07 10 04 11 05 18 13 27 20 28 33 30 34
07 07 16 14 19 24 24 25 27 26 33 32 35 35

a11に”検索値”が1個コピーされ、
次にa1~n10までのセルの内容がa12~n22にコピーされた後、
コピーされた検索値の07で検索後に07が入った下記の５マス（20セル）が塗潰される。
c12,d12,c13,d13 ・・・ 3個一致なので、緑色で塗潰される。
c14,d14,c15,d15 ・・・　1個一致なので、黄色で塗潰される。
e14,f14,e15,f15　・・・　1個一致なので、黄色で塗潰される。
a18,b18,a19,b19　 ・・・2個一致なので、赤色で塗潰される。
a20,b20,a21,b21 ・・・４個一致なので、青色で塗潰される。

※複写数と検索値が複数件ある場合は、複写数の数だけ下にa1~n10の内容がコピーされて、
　検索値の値の左側から１個ずつコピーされその値で検索される。

〇注意事項
　・使用するエクセルは2010です。
　・1マス＝4セルです。※a1,a2,b1,b2で１マスです。
　・セルに入っている数字はランダムで、同じ数字の重複は35マス（140セル）全体で
　　 4個迄です（１マスに4個入る事も有るし、4マスに1個ずつ入る事もあります。）
　・検索値欄に入力できる数字は最大37個で、1~37迄の数字です。
　 ・複写数欄に入力できる数字は1~37迄の１つです。
　　※複写数と検索値の数は一致していない場合はエラーとして動作をSTOPします。
　　　例1）複写数：3、検索値：2,5,4,37,18 →検索値の数と複写数が不一致。
　 例2）複写数：0　検索値：3 →複写数がゼロのため。
　　　例3）複写数：1 検索値：0 →検索値がゼロのため。
　　※複写数分、a1~n10の140個のセルは下にコピーされ、検索値の値は左から
　　　１つずづ使用して、実際の検索と結果としての値として使用します。
　・セルの数字は表示上、2桁で表しています。（例：1ではなく01）

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

回答No.1

watabe007 · ベストアンサー

Sub Test()
　　Dim keyWord As String
　　Dim i As Long, n As Long
　　Dim Target As Range

　　n = Range("P2").Value '複写数
　　Range("A11:N428").Clear
　　For i = 1 To n
　　　　keyWord = Cells(1, 15 + i).Value '検索値
　　　　Cells(i * 11, 1).Value = keyWord
　　　　Set Target = Cells(i * 11 + 1, 1).Resize(10, 14)
　　　　Range("A1:N10").Copy Target
　　　　Target.Interior.Color = xlNone
　　　　Call Fillwork(keyWord, Target)
　　Next
End Sub
Function Fillwork(k As String, Target As Range)
　　Dim fnd As Range, R As Boolean, c As Boolean
　　Dim adr As String

　　Set fnd = Target.Find(What:=k, LookIn:=xlValues, _
　　　　LookAt:=xlWhole, SearchOrder:=xlByRows, MatchByte:=True)
　　If fnd Is Nothing Then
　　　　MsgBox k & " は見つかりませんでした。", 48
　　　　Exit Function
　　End If
　　adr = fnd.Address
　　Do
　　　　If Target.Item(1).Row Mod 2 <> 0 Then
　　　　　　R = fnd.Row Mod 2 = 0
　　　　Else
　　　　　　R = fnd.Row Mod 2 <> 0
　　　　End If
　　　　c = fnd.Column Mod 2 = 0
　　　　With fnd.Offset(R, c).Resize(2, 2).Interior
　　　　　　If .Color = vbYellow Then
　　　　　　　　.Color = vbRed
　　　　　　ElseIf .Color = vbRed Then
　　　　　　　　.Color = vbGreen
　　　　　　ElseIf .Color = vbGreen Then
　　　　　　　　.Color = vbBlue
　　　　　　ElseIf .Color = vbWhite Then
　　　　　　　　.Color = vbYellow
　　　　　　End If
　　　　End With
　　　　Set fnd = Target.FindNext(fnd)
　　Loop While adr <> fnd.Address
End Function

お礼

いつも回答頂きありがとうございます。
前回迄のやつは、１個ずつハードコピーを取らないといけなく
手間があったので質問しました。
これ１回動かせば結果が全てわかります。
ありがとうございました。