Excel VBA-是否有一种方法可以在一张工作表上设置多个范围，以允许不同的双击事件？

我正在尝试在Excel 2010中创建一个虚拟调度板。我有一个区域是编码的，因此员工只需右键单击单元格将其变为绿色，然后双击将其变回红色

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("ColorRange")) Is Nothing Then
Cancel = True
Target.Interior.ColorIndex = 3
End If
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
If Not Intersect(Target, Range("ColorRange")) Is Nothing Then
Cancel = True
Target.Interior.ColorIndex = 4
End If
End Sub

我想在同一张纸上添加不同的范围，以便能够使用相同的功能，但颜色不同。这可能吗

---

任何可能的帮助都将不胜感激，谢谢，

一个工作表的多个双击事件

路易斯·西奎特的方法是正确的。但是是的，您可以有多个双击事件，使用WithEvents是正确的答案。 我建议这样做：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    dim newColor: newColor = null
    If Intersect(Target, Range("ColorRange")) Then newColor = 3
    If Intersect(Target, Range("SomeRange2")) Then newColor = 4
    If Intersect(Target, Range("SomeRange3")) Then newColor = 5
    if not isnull(newColor) then Cancel = True: Target.Interior.ColorIndex = newColor
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    dim newColor: newColor = null
    If Intersect(Target, Range("ColorRange")) Then newColor = 6
    If Intersect(Target, Range("SomeRange2")) Then newColor = 7
    If Intersect(Target, Range("SomeRange3")) Then newColor = 8
    if not isnull(newColor) then Cancel = True: Target.Interior.ColorIndex = newColor
End Sub

---

通过对范围使用表单控件，您可能会有不同的事件，但这将使修改单元格和查找单击的范围变得困难

可以将重复代码放入函数中。我无法测试代码，但只是为了展示想法：

DoubleClickColors = [{1,2,3}]  ' Variant(1 To 3)
 RightClickColors = [{4,5,6}]
Dim colorAreas As Areas

Private Function check(ByVal Target As Range, colors) As Boolean ' False by default
    check = False ' optional
    if colorAreas Is Nothing Then Set colorAreas = Range("ColorRange,ColorRange2,ColorRange3").Areas ' or one named range with multiple areas

    For i = 1 to colorAreas.Count
        If Not Intersect(Target, colorAreas(i)) Is Nothing Then
            Target.Interior.ColorIndex = colors(i)
            check = True
            Exit Function
        End If
    Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = check(Target, DoubleClickColors)
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = check(Target, RightClickColors)
End Sub

---

如果不相交（目标、范围（“ColorRange”））则添加更多

，然后添加行，并为
“ColorRange”
“ColorRange”添加不同的范围名称？这非常有效@Gserg谢谢！这是如此普遍，以至于当微软发明VSTO时，他们提供了NamedRange控件，以便一个范围可以处理自己的事件。谢谢@ThomasInzina我尝试了你的建议，它非常适合ColorRange，但是当我点击定义为ColorRange2的区域时，什么都没有发生。双击仅打开单元格，右键单击将显示格式选项。我错过什么了吗？再次感谢。在工作表成为活动工作表之前，不会设置对工作表的引用。激活另一个工作表，然后切换回。在那之后它应该可以工作。可能您需要将
Cancel
内部检查功能重命名为
check
DoubleClickColors = [{1,2,3}]  ' Variant(1 To 3)
 RightClickColors = [{4,5,6}]
Dim colorAreas As Areas

Private Function check(ByVal Target As Range, colors) As Boolean ' False by default
    check = False ' optional
    if colorAreas Is Nothing Then Set colorAreas = Range("ColorRange,ColorRange2,ColorRange3").Areas ' or one named range with multiple areas

    For i = 1 to colorAreas.Count
        If Not Intersect(Target, colorAreas(i)) Is Nothing Then
            Target.Interior.ColorIndex = colors(i)
            check = True
            Exit Function
        End If
    Next
End Sub

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = check(Target, DoubleClickColors)
End Sub

Private Sub Worksheet_BeforeRightClick(ByVal Target As Range, Cancel As Boolean)
    Cancel = check(Target, RightClickColors)
End Sub