特定のセルを選択すると別のセルを塗りつぶす方法

質問

①セルC5:C36の範囲のどこかを選択していると、セルB3:E3(結合されたセル)とセルB4のセルをオレンジ色に塗りつぶし、範囲以外の場所になると塗りつぶしを解除するVBAなどはどの様にすれば宜しいでしょうか？

②セルE5:E36の範囲のどこかを選択していると、セルB3:E3(結合されたセル)とセルE4のセルをオレンジ色に塗りつぶす方法を追加する場合はどうすれば宜しいでしょうか？選択範囲外になると塗りつぶしは解除させます。

③セルG5:G36の範囲のどこかを選択していると、セルG3:I3(結合されたセル)とセルG4のセルをオレンジ色に塗りつぶす方法を追加する場合はどうすれば宜しいでしょうか？選択範囲外になると塗りつぶしは解除させます。

回答No.3

HohoPapa · ベストアンサー

既にコメントされていますように
規則性がなさそうですので、
後記コードのような「泥臭い」コードになりましょう。

対象列を増やしたい場合にコードをどのように修正するかは
イメージできるだろうと思います。

また、
https://okwave.jp/qa/q10041820.html
の延長にあるものであれば、
今回提示の対応に合わせて
https://okwave.jp/qa/q10041820.html
で提示したコードを修正したほうがいいかもしれません。

Option Explicit

Const BRng1 = "C5:C36"
Const BRng2 = "E5:E36"
Const BRng3 = "G5:G36"
Const BRng4 = "I5:I36"
Const BRng5 = "K5:K36"
Const BRng6 = "M5:M36"

Const Clr1 = "B3:E3,B4"
Const Clr2 = "B3:E3,E4"
Const Clr3 = "G3:I3,G4"
Const Clr4 = "G3:I3,I4"
Const Clr5 = "J3:M3,K4"
Const Clr6 = "J3:M3,M4"

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

　colorClear

　If Not Intersect(Target, Range(BRng1)) Is Nothing Then
　　Range(Clr1).Interior.Color = rgbOrange
　End If

　If Not Intersect(Target, Range(BRng2)) Is Nothing Then
　　Range(Clr2).Interior.Color = rgbOrange
　End If

　If Not Intersect(Target, Range(BRng3)) Is Nothing Then
　　Range(Clr3).Interior.Color = rgbOrange
　End If

　If Not Intersect(Target, Range(BRng4)) Is Nothing Then
　　Range(Clr4).Interior.Color = rgbOrange
　End If

　If Not Intersect(Target, Range(BRng5)) Is Nothing Then
　　Range(Clr5).Interior.Color = rgbOrange
　End If

　If Not Intersect(Target, Range(BRng6)) Is Nothing Then
　　Range(Clr6).Interior.Color = rgbOrange
　End If

End Sub

Sub colorClear()

　Range(Clr1).Interior.Pattern = xlNone
　Range(Clr2).Interior.Pattern = xlNone
　Range(Clr3).Interior.Pattern = xlNone
　Range(Clr4).Interior.Pattern = xlNone
　Range(Clr5).Interior.Pattern = xlNone
　Range(Clr6).Interior.Pattern = xlNone

End Sub

お礼

ありがとうございます！
無事に解決出来ました。
また宜しくお願いします。

回答No.2

SI299792

C5:C36,E5:E36 →B3:E3,B4
G5:G36,I5:I36 →G3:I3,G4
K5:K36,M5:M36 →J3:M3,J4
上記の様に塗りつぶしの範囲を増やしていくのですか。

規則性が無いので不可能です。
選択場所は４列毎という規則がありますが、
塗りつぶし位置は
B3とG3は列差が５
G3とJ3は列差が３
塗りつぶす列数も、4 3 3 と不規則です。

次はどうなるのですか、まさか列差が１になり、
O5:O36,Q5:Q36 →K3:N3,K4
になるのですか。（前の塗りつぶし場所とダブります）

整理して再質問することをお勧めします。
ここは難解質問してもただですから。

お礼

ありがとうございます！
無事に解決出来ました。
また宜しくお願いします。

回答No.1

SI299792

C5:C36→B3:E3,B4
E5:E36→B3:E3,B4
G5:G36→G3:I3,G4
規則性はないのですね。他を選択したら色なしでいいですか。
'
Private Sub Worksheet_SelectionChange(ByVal Target As Range)
'
　　[B3:B4,G3:G4].Interior.Pattern = xlNone
'
　　If Not Intersect([C5:C36,E5:E36], Target) Is Nothing Then
　　　　[B3:B4].Interior.Color = rgbOrange
　　ElseIf Not Intersect([G5:G36], Target) Is Nothing Then
　　　　[G3:G4].Interior.Color = rgbOrange
　　End If
End Sub

お礼

ありがとうございます！
無事に解決出来ました。
また宜しくお願いします。

補足

ありがとうございます。
もう一つ質問させて下さい。

①セルI5:I36の範囲のどこかを選択していると、セルG3:I3(結合されたセル)とセルI4のセルをオレンジ色に塗りつぶす方法を追加する場合はどうすれば宜しいでしょうか？選択範囲外になると塗りつぶしは解除させます。

②セルK5:K36の範囲のどこかを選択していると、セルJ3:M3(結合されたセル)とセルK4のセルをオレンジ色に塗りつぶす方法を追加する場合はどうすれば宜しいでしょうか？選択範囲外になると塗りつぶしは解除させます。

②セルM5:M36の範囲のどこかを選択していると、セルJ3:M3(結合されたセル)とセルM4のセルをオレンジ色に塗りつぶす方法を追加する場合はどうすれば宜しいでしょうか？選択範囲外になると塗りつぶしは解除させます。

④上記の様に塗りつぶしの範囲を増やしていく場合はどの様にすれば宜しいでしょうか？