Excel VBA – 有没有办法在一张纸上有多个范围，允许不同的双击事件？

我想在Excel 2010中创build虚拟计划板。我有一个编码区域，员工只需右键单击一个单元格将其变成绿色，然后双击将其变回红色。

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 

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

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

Answer 1

我这样build议：

 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 

Answer 2

多个双击事件的工作表

Luis Siquot有正确的方法。 但是，您可以有多个使用WithEvents的双击事件是正确的答案。

 Private WithEvents WorksheetWatcher As Worksheet Private Sub Worksheet_Activate() Set WorksheetWatcher = Me End Sub 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 ' WorksheetWatcher Private Sub WorksheetWatcher_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("ColorRange2")) Is Nothing Then Cancel = True Target.Interior.ColorIndex = 5 End If End Sub Private Sub WorksheetWatcher_BeforeRightClick(ByVal Target As Range, Cancel As Boolean) If Not Intersect(Target, Range("ColorRange2")) Is Nothing Then Cancel = True Target.Interior.ColorIndex = 6 End If End Sub 

Answer 3

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

你可以把重复的代码放在一个函数中。 我无法testing代码，只是为了显示这个想法：

 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