指定した回数で２個の検索値で検索して赤で塗潰す方法

質問

いつもお世話になっております。
どなたかご存知でしたら回答をお願いします。
（できれば、SI299792様やnishi6様から回答頂けるとありがたいです。）
【質問】
　添付図のとおり、5列×20行に1～31迄の数字がA1～E20迄で重複在りで
　入っています。M1とN1に検索する数字が入り、最大25行数字が入っています。
　K1に1～25迄の繰り返し回数を入れるとA1～E20までの内容を下にコピー
　しながら、2個の検索値で検索をして見つかれば赤色に塗り潰す方法が知りたい
　です。
　◎動作について
　　(1)A1～E20までの内容をK1の数字分を下にコピーします。
　　(2)M1とN1の値をG1とH1に入れます。（L1の”検索値”をF1に入れます。）
　　(3)M1とN1の値でA1～E20までの数字を検索して該当あれば赤色に
　　　塗り潰します。
　　※以降、K1の回数分、(2)～(3)を繰り返します。
【注意事項】
　　・使用するエクセルは２０１６です。

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

回答No.1

nishi6 · ベストアンサー

結果は添付図と少し違いました。15行目。

Sub paintRed()
　Dim intRange As Range
　Dim kaisuu As Integer
　Dim kensakuV As Range
　Set intRange = Range("A1:H20")
　kaisuu = Range("K1")
　Set kensakuV = Range("M1:N" & kaisuu)
　Range("A22:H" & 21 * kaisuu).Clear
　Range("A1:E20").Interior.Pattern = xlNone

　Dim k As Integer
　Dim r As Long
　Dim c As Integer
　Dim rw As Long
　Dim icchi(2, 2) As Integer

　Application.ScreenUpdating = False
　'// コピー
　intRange.Copy
　For k = 1 To kaisuu
　　rw = (k - 1) * 21 + 1
　　With Range("A" & rw)
　　　.Select: ActiveSheet.Paste
　　　.Offset(0, 6) = Application.Index(kensakuV, k, 1)
　　　.Offset(0, 7) = Application.Index(kensakuV, k, 2)
　　End With
　Next

　For k = 1 To kaisuu
　　rw = (k - 1) * 21 + 1
　　With Range("A" & rw)
　　　For r = 1 To 20
　　　　'// 検索
　　　　icchi(1, 1) = -1: icchi(2, 1) = -1
　　　　For c = 1 To 5
　　　　　If .Offset(r - 1, c - 1) = .Offset(0, 6) Then
　　　　　　icchi(1, 1) = r - 1: icchi(1, 2) = c - 1
　　　　　End If
　　　　　If .Offset(r - 1, c - 1) = .Offset(0, 7) Then
　　　　　　icchi(2, 1) = r - 1: icchi(2, 2) = c - 1
　　　　　End If
　　　　Next
　　　　'// 色
　　　　If icchi(1, 1) >= 0 And icchi(2, 1) >= 0 Then
　　　　　.Offset(icchi(1, 1), icchi(1, 2)).Interior.ColorIndex = 3
　　　　　.Offset(icchi(2, 1), icchi(2, 2)).Interior.ColorIndex = 3
　　　　End If
　　　Next
　　End With
　Next
　Application.CutCopyMode = False
　Range("A1").Select
　Application.ScreenUpdating = True
End Sub

お礼

早速の回答頂きありがとうございます。
15行目の”3　30”を塗潰すの忘れてました。
ご指摘ありがとうございました。
またよろしくお願いします。