複数条件でのダブルクリック

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
'減免の設定　減免列をダブルクリックしセルを赤く塗りつぶす、同じ動作で解除する

If Intersect(Target, Range("T2:T1662")) Is Nothing Then Exit Sub
With Target
If .Interior.ColorIndex <> 3 Then
.Interior.ColorIndex = 3
.Offset(0, 0).Value = "減免"
.Offset(0, -18).Value = "a"
Else
.Interior.ColorIndex = xlNone
.Offset(0, 0).Value = ""
.Offset(0, -18).Value = ""
End If
End With
Cancel = True

'期間限定の設定　x列をダブルクリックしセルを黄色に塗りつぶす、同じ動作で解除する

If Intersect(Target, Range("X2:X1662")) Is Nothing Then Exit Sub
With Target
If .Interior.ColorIndex <> 6 Then
.Interior.ColorIndex = 6
.Offset(0, 0).Value = "期間限定"

Else
.Interior.ColorIndex = xlNone
.Offset(0, 0).Value = ""

End If

End With
Cancel = True

End Sub

上記のマクロで上段の赤の色付けと文字の書き込みはできるのですが、下段の黄色の色付けと文字の書き込みができません。X2:X1662をダブルクリックで黄色に、該当セルに「期間限定」の文字を入れるにはどうしたらよいか教えて下さい。

No.2 ベストアンサー 回答者： tom04 回答日時： 2018/01/24 16:01

こんにちは！

T列の色は「赤」、X列の色は「黄色」しか選択しないのですよね？

↓のような感じではどうでしょうか？

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Intersect(Target, Range("T:T,X:X")) Is Nothing Then Exit Sub
With Target
If .Row < 2 Or .Row > 1662 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 = "期間限定"
Else
.Interior.ColorIndex = xlNone
.ClearContents
End If
End If
End With
End Sub

※　B列はT列の色付けをなくした時点でデータ消去になっていますが、
X列は何も操作しなくてよいのですかね？m(_ _)m

この回答へのお礼

期待通りの結果が得られました。ありがとうございました。

お礼日時：2018/01/24 16:30

No.1 回答者： fujillin 回答日時： 2018/01/24 15:52

こんにちは

あまりきちんと見ていませんが・・・

最初の
＞If Intersect(Target, Range("T2:T1662")) Is Nothing Then Exit Sub
で、クリックしたセルがT列以外だと処理を終了していますよね？
それなので、X列云々の処理が実行されることは決してないということになっています。

処理を終了せずに、Elseなどで下の方の処理を行うような制御にしておけば宜しいのではないでしょうか。