エクセルVBAのイベントで質問です。

#3 さんのコードでよいのでしたら、こちらの解釈とは、かなり違うようですね。 >その指定した範囲をダブルクリックしたときに色が変わるように >したい、色を変えたい範囲が今後増えたり、範囲が変わっても >対応ができるようにしたいのです。 ということで、書き換えたのです。本来、ダブルクリック・イベントでは、1セルしかありません。範囲に対して作業するような書き方がありましたので、ダブルクリック・イベントに、複数のセルに対して可能するように設けました。 ダブルクリックだけでは、不可能なはずです。お求めになっていることに対して、私は、どうやら理解していないようですし、良く分からなくなりました。たぶん、この先、説明を受けても理解できる自信がありません。 なお、初歩的なことですが、モジュールの先頭に Dim ur As Range Dim TargetRange As Range を、モジュール・スコープの変数の宣言をしないと、イベントは正しく稼動しません。

こんな感じでしょうか？ ’------------------------------------------------------------ Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim r As Range Set r = Intersect(Target, Range(Range("a2").Value & ":" & Range("a3").Value)) If r Is Nothing Then Exit Sub With r.Interior If .ColorIndex = xlNone Then .ColorIndex = 3 ElseIf .ColorIndex = 3 Then .ColorIndex = 4 ElseIf .ColorIndex = 4 Then .ColorIndex = xlNone End If End With Cancel = True End Sub ’------------------------------------------------------------ Set r = Intersect(Target, Range("D5:D50,F5:F50,K5:K50,M5:M50")) を Set r = Intersect(Target, Range(Range("a2").Value & ":" & Range("a3").Value)) にしただけです ということは Set r = Intersect(Target, Range(Range("a2").Value)) としておいて セルA2に　D5:D50,F5:F50,K5:K50,M5:M50　もありです 色々アレンジしてみてください

こんにちは。 >その指定した範囲をダブルクリックしたときに色が変わるように 通常のダブルクリック・イベントは、範囲を指定しても、それだけでは、セルひとつしか選択できません。それでは、範囲がなくなってしまいます。そこで、イベントを組み合わせますが、私がいつも使っているダブルクリック・イベントでも、確実にセルにヒットしないと、ショートカット（枠線をダブルクリックしてはいけません）が働いてしまいますので、どんなものでしょうね。なかなか、複雑な内容で、実用には少し疑問を持っています。 'シートモジュール Dim ur As Range Dim TargetRange As Range Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) 　　Dim c As Variant 　　Cancel = True 　　If ur Is Nothing Then 　　　　If TargetRange Is Nothing Then 　　　　　　Coloring Target 　　　　End If 　　ElseIf TargetRange.Count > 1 Then 　　　　Coloring TargetRange 　　End If 　　Set ur = Nothing 　　Set TargetRange = Nothing End Sub Private Sub Worksheet_SelectionChange(ByVal Target As Range) If Not ur Is Nothing Then Exit Sub MakeRange If Not Intersect(Target, ur) Is Nothing Then 　 Set TargetRange = Intersect(Target, ur) End If End Sub Function MakeRange() Dim c As Range 　　For Each c In Range("A2", Range("A65536").End(xlUp)) 　　　　If ur Is Nothing Then 　　　　　　Set ur = Range(c.Value, c.Offset(, 1).Value) 　　　　Else 　　　　　　Set ur = Union(ur, Range(c.Value, c.Offset(, 1).Value)) 　　　　End If 　　Next c End Function Sub Coloring(TargetRange As Range) Dim c As Variant 　　For Each c In TargetRange 　　　　With c.Interior 　　　　　　If .ColorIndex = xlNone Then 　　　　　　　　.ColorIndex = 3 　　　　　　ElseIf .ColorIndex = 3 Then 　　　　　　　　.ColorIndex = 4 　　　　　　ElseIf .ColorIndex = 4 Then 　　　　　　　　.ColorIndex = xlNone 　　　　　　End If 　　　　End With 　　Next c End Sub

こんばんは。 そこまで出来ているのだから、頑張って自力でやったほうが良いような気もしますが。自分でできるはずです。もしかしたら、違うかもしれませんが、A2 または、A3 をダブルクリックしたら色が変わるようになっています。 '----------------------------------- Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) Dim a As String Dim b As String Dim r As Range Dim c As Variant If Target.Address(0, 0) <> "A2" And _ 　 Target.Address(0, 0) <> "A3" Then Exit Sub 　　a = Range("A2").Value 　　b = Range("A3").Value 　On Error Resume Next 　Set r = Range(a & ":" & b) 　If Err.Number > 0 Then Exit Sub 　On Error GoTo 0 　If Not r Is Nothing Then 　　For Each c In r 　　With c.Interior 　　　　If .ColorIndex = xlNone Then 　　　　　　.ColorIndex = 3 　　　　ElseIf .ColorIndex = 3 Then 　　　　　　.ColorIndex = 4 　　　　ElseIf .ColorIndex = 4 Then 　　　　　　.ColorIndex = xlNone 　　　　End If 　　End With 　　Next c 　End If 　Cancel = True End Sub