ＶＢＡ セルの色づけ

質問

Excel知識が乏しく、質問させていただきます。
まったくの初心者です…

セルのA5～A30までの
セルごとにそれぞれ色をつけます。
色は、無色または赤です。

セルA5に赤色をつけたときには、同一シート内のセルC10からC13とD10からD12までセルA5と同じ色になるように。

A5が、無色のときには上記同一セルも無色にするようなイメージです。

同様にA6が赤色の時に、E3～E7、F3～F6に赤色がつく。
そんな設定ができるようにするマクロが必要です。

日々変わる色設定を手作業で行うのが困難になってきました…。
方法についで教えていただきたいです。

回答No.5

SI299792

すみません。マシントラブルで返事できませんでした。

A5　C10～C13、D10～D12
A6　E3～E7、F3～F6
A7　C20～C21、D20～21
A8　E20～24、D23～24
に色を付ける。

規則性がありませんね。すべて上げていただかないと。
１つのアイデアなのですが、
Ａ列に色を付けたいアドレスと色を入れて、マクロを動かす。すると所定の場所にセルと同じ色がつくというのはどうでしょうか。

https://box.yahoo.co.jp/guest/viewer?sid=box-l-bahport3hkq3a2qccdcvb63m3e-1001&uniqid=8c210c44-7db4-4eab-bf39-4ae74dd5672c&viewtype=detail

Ａ列に既にデータが入っているなどて使えないのであれば、コメントにする。別シートにするなど、方法はあります。

回答No.4

watabe007

>この部分だけでもエラーが出てしまいました…。
どの様なエラーですか？
>A7であればC20～C21とD20～21
>A8であればE20～24.D23～24です
以下、条件追加分
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
With Target
If Intersect(.Cells, Range("A1:A30")) Is Nothing Then Exit Sub
Select Case .Address(0, 0)
Case "A5"
Range("C10:C13,D10:D12").Interior.Color = .Interior.Color
Case "A6"
Range("E3:E7,F3:F6").Interior.Color = .Interior.Color
Case "A7"
Range("C20:D21").Interior.Color = .Interior.Color
Case "A8"
Range("D23:D24,E20:E24").Interior.Color = .Interior.Color

End Select
End With
Cancel = True
End Sub

回答No.3

SI299792

ごめんなさい。私の回答は間違いです。質問を読み間違えました。
A7が赤色の場合、A8が…どこに色を付けるのですか？

補足

回答ありがとうございます！

A7であればC20～C21とD20～21
A8であればE20～24.D23～24です。
本当にランダムな位置、セルの形で申し和ないです

回答No.2

SI299792

A7が赤色の時に、G3～G7、H3～H6という風にA30 まで続くのですね。
色はフォントの色でしょうか、塗りつぶしでしょうか。
塗りつぶしで作りました。
色を付けた後実行してください。
'
Option Explicit
'
Sub Macro1()
'
　　Dim Row As Long
'
　　For Row = 5 To 30
　　　　Cells(1, Row * 2 - 9).Range("C10:C13,D10:D12").Interior.Color _
　　　　　 = Cells(Row, "A").Interior.Color
　　Next Row
End Sub

フォントの色の場合。InteriorをFontに変更してください。

補足

説明不足で申し訳ありません！

色付けをする位置は規則性のない所定のセル範囲になります。
A7であればC20～C21とD20～21。
その他も別な所定のセルに色が入るようにしたいです。
各地域の区ごとの色付けに利用するので、対象の区の地図のようなものを作成しています。
セル範囲に名称をつけるなどして設定した方がいいのでしょうか…

回答No.1

watabe007

セルの色づけ をトリガーにするイベントがないので
色づけ後、当セルをダブルクリックするとマクロが実行します。
以下をシートモジュールに貼り付けてください。
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　With Target
　　　　'A1:A30以外をダブルクリックした時はExit
　　　　If Intersect(.Cells, Range("A1:A30")) Is Nothing Then Exit Sub
　　　　Select Case .Address(0, 0)
　　　　　　Case "A5"
　　　　　　　　'A5をダブルクリックするとC10:C13とD10:D12までA5と同じ色になる
　　　　　　　　Range("C10:C13,D10:D12").Interior.Color = .Interior.Color
　　　　　　Case "A6"
　　　　　　　　'A6をダブルクリックするとE3:E7とF3:F6までA6と同じ色になる
　　　　　　　　Range("E3:E7,F3:F6").Interior.Color = .Interior.Color

　　　　End Select
　　End With
　　Cancel = True
End Sub

補足

回答ありがとうございます！

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
　　With Target

この部分だけでもエラーが出てしまいました…。