通过点击/触摸在 Microsoft Excel 上为单元格着色

Question

我正在尝试创建 VBA 脚本，允许我在平板电脑/台式机上单击或点击 Microsoft Excel 2013 中的单元格，并且该单元格（在 F 列中）将颜色变为绿色。

然后我希望它旁边的单元格（在 G 列中）具有相同的功能，以便它可以更改为红色。

这个想法是，F 列中的单元格是“是”对问题的回答，当点击时会亮起绿色，而 G 列中的单元格是“否”，对问题的回答会在点击时亮起红色。

到目前为止，我编写的代码允许我将 F 列中的单元格点亮为绿色，但我不确定如何在 G 列中执行此操作，因为我之前没有编写太多 VBA 脚本。

这是我的代码

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

Cancel = True
Worksheet_SelectionChange Target

结束子

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Intersect(Target, Range("F:F")) Is Nothing Then Exit Sub

    'if cell fill is Blank, change to Green
    If Selection.Interior.Color = RGB(255, 255, 255) Then
        Selection.Interior.Color = RGB(50, 200, 50)
        GoTo Passem


    'if cell fill is Green, remove fill color
    ElseIf Selection.Interior.Color = RGB(50, 200, 50) Then
            With Selection.Interior
            .Pattern = x1None
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With



ElseIf Intersect(Target, Range("G:G")) Is Nothing Then Exit Sub

    'if cell fill is Blank, change to Red
    If Selection.Interior.Color = RGB(255, 255, 255) Then
        Selection.Interior.Color = RGB(250, 20, 20)
        GoTo Passem

    'if cell fill is Red, remove fill colour
    ElseIf Selection.InteriorColor = RGB(250, 20, 20) Then
        With Selection.Interior
            .Pattern = x1None
            .TintAndShade = 0
            .PatternTintAndShade = 0
        End With
    End If
End If

密码：

结束子

Answer 1

我想如下让您的代码更轻松地处理未来的增强功能：

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    If Target.Count = 1 Then HandleCellColor Target '<--| go on only if one cell is selected 
End Sub

Sub HandleCellColor(rng As Range)
    Select Case rng.Column '<--| check what column you're dealing with and act accordingly
        Case 6 ' column "F"
              SetCellColor rng, RGB(50, 200, 50) 
        Case 7 ' column "G"
              SetCellColor rng, vbRed '<--| it's easier to reference vba colors enumeration,  if they suit you
     End Select
End Sub 


Sub SetCellColor(rng As Range, rgbColor As Long)
    With rng.Interior
        If .Color = vbWhite Then '<--| vbWhite is equivalent to RFB(255, 255, 255)
            .Color = rgbColor 
        ElseIf .Color = rgbColor Then
            .Color = vbWhite
            .Pattern = xlNone
            .TintAndShade = 0
            .PatternTintAndShade =  0
         End If
    End With 
End Sub 

我还添加了一条线，将选中或双击的单元格的背景颜色变回白色，该单元格的背景已经用传递的颜色着色