通过双击着色单元格

时间:2014-03-03 16:27:47

标签: excel vba excel-vba

我注意到规则说不要在别人的问题上要求澄清,所以希望这是正确的方法。我最初找到了足够的答案让我在Change color of cell with mouse click in Excel处找到我的位置。谢谢user3159079和tigeravatar。

我有这个:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)    
    Cancel = True
    Worksheet_SelectionChange Target   
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
  'If the target cell is clear
     If Target.Interior.ColorIndex = xlNone Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 4

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 4 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 6

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 6 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 3

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 3 Then

        'Then clear the background color
        Target.Interior.ColorIndex = xlNone

    End If
End Sub

但我有3个问题。

1)我想在不影响其他单元格的情况下指定一些范围(即我希望它可以工作...

$F$4:$F$6
$D$10:$I$12
$F$17:$I$34
$N$5:$O$6
$N$10:$O$11
$O$15:$P$18
$O$24:$P$24
$O$29:$P$29
$O$34:$P$34
$U$6:$X$7
$U$10:$X$14
$AA$6:$AG$8
$F$38:$F$43
$N$38:$N$44
$E$48:$E$51
$Q$48:$R$51
$X$23:$AG$35

......而在其他任何地方。

2)我希望这只能在双击时工作,而不是在第一次单击时更改单元格

3)这一直有效,直到我保存,关闭并重新打开电子表格。重新打开工作表后,点击功能的颜色消失了。

我对这一点都不是很了解,但我能够很好地搜索,这是我如何得到这一点,但我无法进一步弄清楚所以任何帮助将不胜感激。

1 个答案:

答案 0 :(得分:2)

我将下面的代码修改为满足要求1)和2)。

对于要求3):以.xlsm格式保存电子表格,再次打开后,允许运行宏。

让我知道它是怎么回事:

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Dim MyRange As Range

    '(1) Desired Range where it works:
    Set MyRange = Range("$F$4:$F$6,$D$10:$I$12,$F$17:$I$34,$N$5:$O$6," & _
                        "$N$10:$O$11,$O$15:$P$18,$O$24:$P$24,$O$29:$P$29," & _
                        "$O$34:$P$34,$U$6:$X$7,$U$10:$X$14,$AA$6:$AG$8," & _
                        "$F$38:$F$43,$N$38:$N$44,$E$48:$E$51,$Q$48:$R$51," & _
                        "$X$23:$AG$35")
    Cancel = True

    '(1) Check if double clicked cell is one where the code should work:
    If Not Intersect(Target, MyRange) Is Nothing Then
        Custom_ColourChange Target
    End If
End Sub

'(2) Changed from default Worksheet_Selection event to Custom Sub:
Private Sub Custom_ColourChange(ByVal Target As Range)
  'If the target cell is clear
     If Target.Interior.ColorIndex = xlNone Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 4

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 4 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 6

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 6 Then

        'Then change the background to the specified color
        Target.Interior.ColorIndex = 3

        'But if the target cell is already the specified color
        ElseIf Target.Interior.ColorIndex = 3 Then

        'Then clear the background color
        Target.Interior.ColorIndex = xlNone

    End If
End Sub

修改

编辑以下@ BK201和@simoco评论