VBA ダブルクリックで行に色をつける方法

質問

VBAで特定のセルをダブルクリックして、セルを塗りつぶす方法について教えてください。

例えば
-----------
１．
B1をダブルクリックすると、B1：K1が赤になる、
B2をダブルクリックすると、B2：K2が赤になる、
…
B10をダブルクリックすると、B10：K10が赤になる、
-----------
２．
B11をダブルくりっくすると、B11：K11が青になる
B12をダブルクリックすると、B12：K12が青になる、
…
B20をダブルクリックすると、B20：K20が青になる、
-----------
３．
B21をダブルクリックすると、B21：K21が黄になる、
B22をダブルクリックすると、B22：K22が黄になる、
…
B30をダブルクリックすると、B30：K30が黄になる、
-----------
のように10行ごとに塗りつぶす色を変えることはできるでしょうか？

下記質問
https://okwave.jp/qa/q7374899.html
のベストアンサーになっている、keithinさんの回答を参考にさせてもらい、
１．の部分を赤にすることはできるようになりましたが、
２．以降がどうしてもできません。どうぞ、よろしくお願いします。

回答No.3

imogasi

ThisworkbookのSheetBeforeDoubleClickイベントに下記コードをコピペする。
Ｐrivate Sub Workbook_SheetBeforeDoubleClick(ByVal Sh As Object, ByVal Target As Range, Cancel As Boolean)
tr = Target.Row 　'クリックしたセルの行
ct = Array(3, 5, 7, 9)　'50色程度はColorIndex で定義可能。ここでは４ブロック用のみで略。
blk = Int(tr / 10)
MsgBox blk
Range("B" & (blk * 10 + 1) & ":" & "K" & (blk + 1) * 10).Select
Selection.Interior.ColorIndex = ct(blk)
End Sub
ーー
Ｓｈｅｅｔ１の行をダブルクリックすると、そのダブルクリックした行の」属する、１０行ごとブロック単位に色がつくだろう。
ＶＢＡの コード行数を最少数に抑えて、取り急ぎ、作ってみたので質問者の意図に沿えばよいが。
セル色（のブロック単位の色のコードは）は、ColorIndex 方式で定義し、ct = Array(3, 5, 7, 9)の部分で色コードを定義している。
他の色や、他の色の表現がよければ、ＷＥＢで調べてください。

回答No.2

SI299792

すみません、塗りつぶしですね。
“font“を“Interior”に置き換えて下さい。

回答No.1

SI299792

31行目以降は書いていないので、色を付けないとしました。
２種類作りました

メンテナンスを優先しました。ColorTableを増やすだけで色を増やせます。
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
　　Dim ColorTable As Variant
　　Dim ColorCode As Integer
'
　　If Target.Column < 2 Or Target.Column > 11 Or Target.Row > 31 Then
　　　　Exit Sub
　　End If
　　ColorTable = Array(vbRed, vbBlue, vbYellow)
　　ColorCode = (Target.Row - 1) \ 10
　　Range("B" & Target.Row & ":K" & Target.Row).Font.Color = _
　　　　ColorTable(ColorCode)
　　Cancel = True
End Sub

分かりやすさを優先しました。
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
　　If Target.Column < 2 Or Target.Column > 11 Or Target.Row > 31 Then
　　　　Exit Sub
　　End If
'
　　Select Case Target.Row
　　　Case 1 To 10
　　　　Range("B" & Target.Row & ":K" & Target.Row).Font.Color = vbRed
　　　Case 11 To 20
　　　　Range("B" & Target.Row & ":K" & Target.Row).Font.Color = vbBlue
　　　Case 21 To 30
　　　　Range("B" & Target.Row & ":K" & Target.Row).Font.Color = vbYellow
　　End Select
　　Cancel = True
End Sub

どれも、
vbRed　 は　　　255
vbblue　は 16711680
vbyellowは　　65535
のようにコードに置き換えることも可能です。

単に10行ごとに色を変えるだけるなら、以下の方法がります。30行以降のできますが、好きな色は付けられません。単に遊びで作りました。
'
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'
　　If Target.Column < 2 Or Target.Column > 11 Or Target.Row > 541 Then
　　　　Exit Sub
　　End If
'
　　Range("B" & Target.Row & ":K" & Target.Row).Font.ColorIndex = _
　　　 (Target.Row - 1) \ 10 + 3
　　Cancel = True
End Sub