行の連続数字を見つけて塗潰す方法

質問

どなたかご存知でしたら回答をよろしくお願いします。
【質問】
下図の様に５×５のセルが４つあり、それぞれ１~９９迄の数字がランダムに
重複有りで入っています。５×５のセルの中には行の連続数字（例：02　03）
が入っています（１個も無い場合もあります）。
行の連続数字を見つけたら、その連続数字のセルを塗潰す方法が知りたいです。
　・２連続・・・黄色で塗潰す。　
　・３連続・・・赤色で塗潰す。
　・４連続・・・青色で塗潰す。
　・５連続・・・緑色で塗潰す。

　A　B　Ｃ　D　Ｅ　Ｆ　　Ｇ　Ｈ　Ｉ　Ｊ　Ｋ　　
1　01 07 09 11 22　　　　　03 10 20 30 31
2　04 12 14 15 23　　　　　01 02 07 09 22
3　07 13 17 18 25　　　　　04 11 12 14 15
4　06 16 21 24 26　　　　　02 13 17 18 23
5　08 19 27 28 29　　　　　06 16 24 25 26
6
7　05 09 11 26 30　　　　　03 06 13 22 27
8　04 10 15 19 24　　　　　03 14 25 28 29
9　01 14 20 25 29　　　　　05 11 18 20 21
10　07 18 21 23 31　　　　　07 08 16 23 31
11　02 08 12 16 17　　　　　02 03 12 17 27

【結果】
上記４つある５×５のセルには、１0個の重複数字がありその数字のセルが塗潰されます。
(1)14　15　
(2)17　18
(3)27　28　29
(4)30　31
(5)14　15
(6)24　25　26
(7)16　17
(8)28　29
(9)07　08
(10)02　03
【注意事項】
　・使用するエクセルは２０１０です。
　・セルの中の数字は２桁で表しています。（例：1ではなく01）
　・５×５のセルの位置は下記のとおりです。
　　　１個目の５×５マス・・・A1~Ｅ５
　　　２個目の５×５マス・・・G1~Ｋ５　　
　　　３個目の５×５マス・・・A7～E11
　　　４個目の５×５マス・・・G7～K11
　・回答はＶＢでも関数でも構いません。

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

回答No.2

watabe007 · ベストアンサー

Sub Test()
　　Dim c As Range
　　Range("A1:K11").Interior.Color = xlNone
　　For Each c In Range("A1:K11")
　　　　If c.Column = 6 Then
　　　　ElseIf Val(c.Value) + 1 = Val(c.Offset(, 1).Value) Then
　　　　　　If c.Interior.Color = vbWhite Then
　　　　　　　　c.Resize(, 2).Interior.Color = vbYellow
　　　　　　ElseIf c.Interior.Color = vbYellow Then
　　　　　　　　c.Offset(, -1).Resize(, 3).Interior.Color = vbRed
　　　　　　ElseIf c.Interior.Color = vbRed Then
　　　　　　　　c.Offset(, -2).Resize(, 4).Interior.Color = vbBlue
　　　　　　ElseIf c.Interior.Color = vbBlue Then
　　　　　　　　c.Offset(, -3).Resize(, 5).Interior.Color = vbGreen
　　　　　　End If
　　　　End If
　　Next
End Sub

お礼

いつも回答頂きありがとうございます。
早速実行したところ、Ｆ列、６行目をちゃんと空白と捉えて処理されました。
またよろしくお願いします。

回答No.1

SI299792

'
Option Explicit
'
Sub Macro1()
'
　　Dim Colors As Variant
　　Dim Cell As Range
　　Dim BeforeCell As Range
　　Dim StartCell As Range
　　Dim Count As Integer
'
　　[A1:K11].Interior.Pattern = xlNone
　　Colors = Array(vbWhite, vbYellow, vbRed, vbBlue, vbGreen)
'
　　Set BeforeCell = [A1]
'
　　For Each Cell In [A1:L11]
'
　　　　If BeforeCell > "" And Val(Cell) = Val(BeforeCell) + 1 Then
　　　　　　Count = Count + 1
　　　　ElseIf Count > 0 Then
　　　　　　Range(StartCell, BeforeCell).Interior.Color = Colors(Count)
　　　　　　Count = 0
　　　　　　Set StartCell = Cell
　　　　Else
　　　　　　Set StartCell = Cell
　　　　End If
　　　　Set BeforeCell = Cell
　　Next Cell
End Sub

補足

早速のご回答ありがとうございます。
ソースを貼って実行したところ、
G2,Ｈ2の連続数字01,02は黄色の塗潰しになる筈ですが、
空白であるＦ２も含めて、赤で塗潰しされます。
Ｆ列と６行目は４つの５×５のセルがくっつかないために間を取っています。