[[20251214212854]]　『クリックでセルに色付け』（KK）　ページの最後に飛ぶ

『クリックでセルに色付け』（KK）

ネットで検索したコードで申し訳ないのですが調べてたどり着いたコードになります。
左クリックするたびに色付けされます。
これにあと1項目付け加えたく色々試したのですが上手く行きませんでした。
その内容はこのコードの流れでセルの色付け赤を追加したいのですが
赤なので3です。
教えてもらえないでしょうか？
よろしくお願いいたします。

＜使用 Excel：Excel2021、使用 OS：Windows11 ＞

 >左クリックするたびに色付けされます。
肝心なコードがないけど
左クリックで発生するイベントはないと思うが
 >セルの色付け赤を追加したいのですが
Target.Interior.ColorIndex = 3
（はてな） 2025/12/14(日) 21:58:36

忘れてました
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
With Target.Interior
.Pattern = xlCrissCross
Select Case .PatternColor
Case rgbRed
.PatternColor = rgbBlue
Case rgbBlue
.PatternColor = rgbYellow

arget.Interior.ColorIndex = 3
Case rgbYellow
.Pattern = xlNone
Case Else
.PatternColor = rgbRed
End Select
End With
Cancel = True
End Sub

（KK） 2025/12/14(日) 22:38:44

スマホからなので、とりあえず提示のお手伝いだけ。

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
     With Target.Interior
         .Pattern = xlCrissCross

         Select Case .PatternColor
             Case rgbRed
                 .PatternColor = rgbBlue

             Case rgbBlue
                 .PatternColor = rgbYellow
                 .ColorIndex = 3

             Case rgbYellow
                 .Pattern = xlNone

             Case Else
                 .PatternColor = rgbRed

         End Select
     End With

     Cancel = True
 End Sub

（もこな２） 2025/12/15(月) 08:47:19

少し補足

＞左クリックするたびに色付けされます。
コードをみればわかるように右クリックです。

＞赤なので3です。
一応、色パレットは変更できちゃうので「ColorIndex」での指定はオススメしません。
「rgbRed」とされているので、こちらにあわせた方がよいとおもいます。

＞セルの色付け赤を追加したい
「Case rgbRed」とされた部分、「.PatternColor = rgbRed」とされた部分、どちらもありますが、どの辺りが想定外の動作となりますか？

（もこな２） 2025/12/15(月) 09:29:10

解答ありがとうございます
元のコードはそのまま生かして
クリックで赤の塗りつぶしを追加したいです。
今までですと４回クリックで塗りつぶし無しに戻る仕様なのですが
これを４回目でセルを赤く塗りつぶし５回クリックで塗りつぶし無しにしたいのですが
宜しくお願いします
（KK） 2025/12/15(月) 09:54:39

Target.Interior.ColorIndex = 3
を組合そうとすると全体の色のバランスがおかしくなる感じです
よろしくお願いします。
（KK） 2025/12/15(月) 10:00:51

 PatternColorの条件分岐とColorIndexの条件分岐の組み合わせなので、
 Select Caseを二重の入れ子にするか、Select Case の中で、IFの条件分岐を使います。

 違う方法で一番簡単なのは、セルのスタイルを登録して、スタイルの名前で分岐することです
 以下のコードで、
  Normal(標準)→"スタイル 1"→"スタイル 2"→"スタイル 3"→"スタイル 4"→Normal(標準)
 と循環します。

    Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
       Select Case Target.Style
         Case "Normal"
            Target.Style = "スタイル 1"
         Case "スタイル 1"
            Target.Style = "スタイル 2"
         Case "スタイル 2"
            Target.Style = "スタイル 3"
         Case "スタイル 3"
            Target.Style = "スタイル 4"
         Case "スタイル 4"
            Target.Style = "Normal"
       End Select
       Cancel = True
    End Sub
（´・ω・`） 2025/12/15(月) 10:15:21

ちょっと確認ですが、「Case rgbBlue」のとき、「.ColorIndex = 3」するのは、マストですか？

（もこな２） 2025/12/15(月) 11:00:30

 こんな感じでしょうか
 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
   With Target.Interior
      Select Case .PatternColor
         Case rgbRed
            .Pattern = xlCrissCross
            .PatternColor = rgbBlue
         Case rgbBlue
            .Pattern = xlCrissCross
            .PatternColor = rgbYellow
            .ColorIndex = 3
         Case rgbYellow
            .Pattern = xlNone
            .ColorIndex = 3
         Case Else
            If .ColorIndex = 3 Then
               .ColorIndex = xlNone
            Else
               .Pattern = xlCrissCross
               .PatternColor = rgbRed
            End If
      End Select
   End With
   Cancel = True
 End Sub
（´・ω・`） 2025/12/15(月) 12:28:38

 無色、青の網掛け、 黄色の網掛け、赤の網掛け、網掛けなしの赤、無色に戻る
 ということなら

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    With Target.Interior
        Select Case True
            Case .Pattern = xlNone
                .Pattern = xlCrissCross
                .PatternColor = vbBlue
            Case .PatternColor = vbBlue
                .PatternColor = vbYellow
            Case .PatternColor = vbYellow
                .PatternColor = vbRed
            Case .PatternColor = vbRed
                .Pattern = xlNone
                .Color = vbRed
            Case Else
                .ColorIndex = xlNone
        End Select
    End With
    Cancel = True
End Sub
　
（jindon） 2025/12/15(月) 12:33:19

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

Case .PatternColor = vbRed

                .Pattern = xlNone
                .Color = vbRed
            Case Else
の部分を赤と指定でしたので問題ないのですが下のコードの色を使いたい時もあるのですが
何度も試したのですが黒になったり動かなくなったりと・・・
下のコードの色に変更する時はどの様に書き換えたらよいでしょうか？

Range("A5:A7").Select

    With Selection.Interior
        .Pattern = xlSolid
        .PatternColorIndex = xlAutomatic
        .ThemeColor = xlThemeColorAccent3
        .TintAndShade = 0.599993896298105
        .PatternTintAndShade = 0
    End With
End Sub

あたもう一つ教えていただきたいのですが
このクリック範囲を指定できないでしょうか？
編集範囲はB9:AF35になるのですが
よろしくお願いします。
（KK） 2025/12/15(月) 14:30:48

 >下のコードの色を使いたい時もあるのですが
 どのタイミングで使用すするか不明ですが
 最後の赤の次に追加ということなら

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [B9:AF35]) Is Nothing Then Exit Sub '<--- 実行範囲指定
    With Target.Interior
        Select Case True
            Case .Pattern = xlNone
                .Pattern = xlCrissCross
                .PatternColor = vbBlue
            Case .PatternColor = vbBlue
                .PatternColor = vbYellow
            Case .PatternColor = vbYellow
                .PatternColor = vbRed
            Case .PatternColor = vbRed
                .Pattern = xlNone
                .Color = vbRed
            Case .Color = vbRed
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0
            Case Else
                .ColorIndex = xlNone
        End Select
    End With
    Cancel = True
End Sub
　
（jindon） 2025/12/15(月) 14:50:41

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

 Case .Pattern = xlNoneでエラーが出てしまいます
よろしくお願いします。
（KK） 2025/12/15(月) 15:02:00

 こちらでは再現できません。
 どのようは状況下でエラーが発生するのでしょう?
　
（jindon） 2025/12/15(月) 15:09:55

jindon様ごめんなさい
こちらの勘違いでした
End Subを入れ忘れておりました。
教えていただいたコードで理想の動きになっております。
今回親切に面倒見ていただきありがとうございます。
（KK） 2025/12/15(月) 15:16:34

色の追加をしたくコードを追加したらなぜかその部分だけ飛ばされてしまいました。
なにがたりないのですか？
Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)

    If Intersect(Target, [B9:AF35]) Is Nothing Then Exit Sub '<--- 実行範囲指定
    With Target.Interior
        Select Case True
            Case .Pattern = xlNone
                .Pattern = xlCrissCross
                .PatternColor = vbBlue
            Case .PatternColor = vbBlue
                .PatternColor = vbYellow
            Case .PatternColor = vbYellow
                .PatternColor = vbRed
            Case .PatternColor = vbRed
                .Pattern = xlNone
                .Color = vbRed

               Case .Color = vbRed
                 .Pattern = xlSolid
                  .PatternColorIndex = xlAutomatic
                  .ThemeColor = xlThemeColorAccent1
                  .TintAndShade = 0
                  .PatternTintAndShade = 0

            Case .Color = vbRed
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0

                Case Else
                .ColorIndex = xlNone
        End Select
    End With
    Cancel = True
End Sub

この辺を書き足したのですが

 Case .Color = vbRed
                 .Pattern = xlSolid
                  .PatternColorIndex = xlAutomatic
                  .ThemeColor = xlThemeColorAccent1
                  .TintAndShade = 0
                  .PatternTintAndShade = 0

            Case .Color = vbRed
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .ThemeColor = xlThemeColorAccent3
                .TintAndShade = 0.599993896298105
                .PatternTintAndShade = 0

上手く動作しませんでした。
宜しくお願いします

（KK） 2025/12/16(火) 21:46:34

 Case 文に同じ条件は二つ指定できないので、前の状態を識別できる異なる条件にしてみては？
 Case .Color = vbRed And .Pattern = xlNone
 Case .Color = vbRed And .Pattern = xlSolid

（無茶） 2025/12/16(火) 22:18:22

 闇雲に条件を追加しても無理です。
 加工・修正をしたいのならコードの内容を理解する必要があります。

 Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    If Intersect(Target, [B9:AF35]) Is Nothing Then Exit Sub '<--- 実行範囲指定
    With Target.Interior
        Select Case True
            Case .Pattern = xlNone
                .Pattern = xlCrissCross
                .PatternColor = vbBlue
            Case .PatternColor = vbBlue
                .PatternColor = vbYellow
            Case .PatternColor = vbYellow
                .PatternColor = vbRed
            Case .PatternColor = vbRed
                .Pattern = xlNone
                .Color = vbRed
                .TintAndShade = 0
            Case .Color = vbRed
                .Pattern = xlSolid
                .PatternColorIndex = xlAutomatic
                .TintAndShade = 0.599993896298105
                .ThemeColor = xlThemeColorAccent3
            Case .ThemeColor = xlThemeColorAccent3
                .ThemeColor = xlThemeColorAccent1
            Case Else
                .ColorIndex = xlNone
                .TintAndShade = 0
                .ThemeColor = xlNone
        End Select
    End With
    Cancel = True
End Sub
（jindon） 2025/12/17(水) 11:33:09

jindon様ありがとうございます
なんとなくやって出来るわけないですよね
確かに闇雲ですよね
また教えていただく形になってしまいお手間をかけさせてしまいすみませんでした。
助かりましたありがとうございました。
（KK） 2025/12/17(水) 19:41:58

 全てを網掛けにするか、全てを塗り潰しにするか
 単純に色の種類だけ変えれば良いのではないですか？
 最初に飛びついたものにこだわらなくて良いと思います。
（感想） 2025/12/17(水) 20:02:38

コメント返信：

[ 一覧(最新更新順) ]

[[20251214212854]] 『クリックでセルに色付け』（KK） ページの最後に飛ぶ

[[20251214212854]]　『クリックでセルに色付け』（KK）　ページの最後に飛ぶ