複数のセルの色付けについて

複数のセルの色付けについて教えてください。
ダブルクリックでの色付けで下記のコードがあります。

加えて、D列のセルをダブルクリックしてブルーに色付けしたいのですがうまくいきません。
D列に色付けする方法を教えていただきたく、お願いいたします。

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

If Intersect(Target, Range("T:T,U:U")) Is Nothing Then Exit Sub
With Target
If .Row < 2 Or .Row > 1671 Then Exit Sub
Cancel = True
If .Column = Range("T1").Column Then
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 3
.Value = "減免"
Cells(.Row, "B") = "a"
Else
.Interior.ColorIndex = xlNone
.ClearContents
Cells(.Row, "B").ClearContents
End If
Else
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 6
.Value = "期間限定"
Cells(.Row, "I") = Worksheets("設定").Range("F30")
Else
.Interior.ColorIndex = xlNone
.ClearContents
Cells(.Row, "I").ClearContents
End If
End If
End With

End Sub

No.4 回答者： mygoonickname 回答日時： 2022/03/14 15:30

No.1の者です。

Ifの中で、Elseが使えるのは1回だけですね。
End Ifの間違えでは？

If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 5
Else
.Interior.ColorIndex = xlNone
.ClearContents
Else

No.3 回答者： mygoonickname 回答日時： 2022/03/14 14:29

No.1の者です。

＞'処理～　についていろいろと書いて試してみますが、エラーが出て動きません。具体的なコードをお願いします。
どの様なコードを書かかれて、どの様なエラーが出てとかの説明がないと
何とも回答も難しいですが。
あと、どの様な処理をしたいという説明が必要だと思うのですが。。。

取り合えず下記の、’ブルーに色付けの処理のところに追記すれば、D列を
ダブルクリックしたときの処理になるかと思います。


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

If Intersect(Target, Range("D:D,T:T,U:U")) Is Nothing Then Exit Sub
With Target
If .Row < 2 Or .Row > 1671 Then Exit Sub
Cancel = True

If .Column = Range("T1").Column Then
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 3
.Value = "減免"
Cells(.Row, "B") = "a"
Else
.Interior.ColorIndex = xlNone
.ClearContents
Cells(.Row, "B").ClearContents
End If
ElseIf .Column = Range("D1").Column Then
’ブルーに色付けの処理


Else
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 6
.Value = "期間限定"
Cells(.Row, "I") = Worksheets("設定").Range("F30")
Else
.Interior.ColorIndex = xlNone
.ClearContents
Cells(.Row, "I").ClearContents
End If
End If
End With

End Sub

この回答へのお礼

回答ありがとうございます。
ご教示の通りElseIf .Column = Range("D1").Column Then
以下に
If .Interior.ColorIndex = xlNone Then
.Interior.ColorIndex = 5
Else
.Interior.ColorIndex = xlNone
.ClearContents
Else
を書き込んで実行すると下から2番目のElseのところで「Else」に対応するIfがありません、と出ます。

お礼日時：2022/03/14 15:10

No.2 回答者： mygoonickname 回答日時： 2022/03/14 11:57

No.1の者です。

列毎の処理が、どれ位の種類があるかにもよりますが、幾つもあるなら、
Select Caseで処理を分けた方が楽かと思います。

Ifなら、ElseIfで、列毎に下記を追加も可能ですが。

With Target
If .Column = 4 Then
'処理～
ElseIf .Column = 21 Then
'処理～
ElseIf .Column = 22 Then
'処理～

End If
End With

この回答へのお礼

回答ありがとうございます。
'処理～　についていろいろと書いて試してみますが、エラーが出て動きません。
具体的なコードをお願いします。

お礼日時：2022/03/14 12:35

No.1 回答者： mygoonickname 回答日時： 2022/03/14 11:20

こんにちは

最初のコードで、D:Dを追加が必要ですね。
これがないと、Exit Subで処理を抜けてしまいますね。

If Intersect(Target, Range("D:D,T:T,U:U")) Is Nothing Then Exit Sub

もし、列毎に処理を分けるなら、Select Caseで列毎に処理を分けるのが
良いのでは？と思います。

(例)
Select Case Target.Column
Case 4 'D列
’処理～
Case 20 ’T列
’処理～
Case 21 ’U列
’処理～
End Select

この回答へのお礼

回答ありがとうございます。
最初の処理にD:Dを加えるだけでは、最後の「期間限定」黄色の処理が適用されます。
Elseでいろいろ処理を書いてみましたがうまくいきませんでした。

お礼日時：2022/03/14 11:48