Excel VBAで決まった範囲のセルに色を付ける方法

質問

• Excel VBAを使用して、決まった範囲内のセルに色を付ける方法について質問があります。
• セルの横に14マス縦に6マスの合計84個のマスのセルがあり、個数の入力セルに任意の数字を入力すると指定した範囲内のセルに色が付きます。
• 初心者ですが、この動作をコマンドボタンで実現したいと考えています。具体的な方法を教えていただけると助かります。

回答No.2

end-u

>決まった範囲内とは、セルの横に14マス縦に6マスの合計84個のマスのセルがあります。
これが具体的にはどの範囲なのでしょう。
例えばM2セルの右14×6なのでしょうか？（N2:AA7？）
そこが不明なので、取り敢えずアクティブセルを起点として考えてみます。
M2セルをアクティブにして実行。

Sub try()
　　Const y = 6　'タテ
　　Const x = 14 'ヨコ
　　Dim r As Long
　　Dim c As Long
　　Dim i As Long

　　With ActiveCell
　　　　'アクティブセルを起点にするから限界域設定
　　　　If .Row > (Rows.Count - y + 1) Or _
　　　　　 .Column > (Columns.Count - x) Then Exit Sub
　　　　　 '起点から右1オフセット、タテy、ヨコx に対して処理
　　　　　 .Offset(, 1).Resize(y, x).Interior.ColorIndex = xlNone
　　　　　　c = x
　　　　　　Do Until .Value <= i
　　　　　　　　.Offset(r, c).Interior.ColorIndex = 1
　　　　　　　　If c = 1 Then
　　　　　　　　　　c = x
　　　　　　　　　　r = r + 1
　　　　　　　　　　If r >= y Then Exit Do
　　　　　　　　Else
　　　　　　　　　　c = c - 1
　　　　　　　　End If
　　　　　　　　i = i + 1
　　　　　　Loop
　　End With
End Sub

もう一つお遊びで
Sub try_2()
　　Const y = 6　'タテ
　　Const x = 14 'ヨコ
　　Dim s As String
　　Dim r As String
　　Dim c As String

　　With ActiveCell
　　　　If .Row > (Rows.Count - y + 1) Or _
　　　　　 .Column > (Columns.Count - x) Then Exit Sub
　　　　s = .Address
　　　　r = "(Row()-Row(" & s & "))*" & x
　　　　c = x & "-COLUMN()+COLUMN(" & s & ")+1"
　　　　'条件付き書式設定
　　　　With .Offset(, 1).Resize(y, x).FormatConditions
　　　　　　.Delete
　　　　　　'"=$M$2 >= (ROW()-ROW($M$2))*14 + 14-COLUMN()+COLUMN($M$2)+1"みたいな式
　　　　　　.Add(Type:=xlExpression, _
　　　　　　　　 Formula1:="=" & s & ">=" & r & "+" & c _
　　　　　　　　 ).Interior.ColorIndex = 1
　　　　End With
　　End With
End Sub
条件付き書式なので手動でもできたりします。
VBAの勉強にはならないでしょうけど。

お礼

ご回答ありがとうございます。見ただけで・・・凄すぎて、なんて言ったら良いか分からいなですが・・・凄いですの一言です。アクティブセルじゃなくて例えば・・・B4を起点とする場合は、Cells(2,4)としてもダメだったんですが、どの様にしたら良いでしょうか？