该vba代码需要双击，如何改为点击就工作？ 附源码

最初的梦想168

该vba需要双击，请改为单击就变色了，不要双击。


请老师帮忙看看！谢谢！


Dim colorCycle As Variant
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' 检查双击的单元格是否在A1:E1区域内
    If Not Intersect(Target, Me.Range("A1:E1")) Is Nothing Then
        ' 初始化颜色循环（如果尚未初始化）
        If IsEmpty(colorCycle) Then
            colorCycle = Array(RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255))
        End If
         
        ' 找到当前颜色的索引并更新为下一个颜色
        Dim currentIndex As Integer
        For currentIndex = LBound(colorCycle) To UBound(colorCycle)
            If Target.Interior.Color = colorCycle(currentIndex) Then
                Exit For
            End If
        Next currentIndex
         
        ' 如果当前索引超出了颜色数组的范围（理论上不应该发生，除非单元格被手动设置了其他颜色）
        ' 则重置为第一个颜色
        If currentIndex > UBound(colorCycle) Then
            currentIndex = LBound(colorCycle)
        End If
         
        ' 应用下一个颜色
        Target.Interior.Color = colorCycle((currentIndex + 1) Mod (UBound(colorCycle) + 1))
         
        ' 取消双击后的默认编辑行为（可选）
        Cancel = True
    End If
End Sub
  
Private Sub Workbook_Open()
    ' 清除任何可能残留的颜色循环变量（虽然在这个特定例子中可能不是必需的，因为每次都会重新初始化）
    colorCycle = Empty
End Sub

最初的梦想168

Dim colorCycle As Variant
  
Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    ' 检查双击的单元格是否在A1:E1区域内
    If Not Intersect(Target, Me.Range("A1:E1")) Is Nothing Then
        ' 初始化颜色循环（如果尚未初始化）
        If IsEmpty(colorCycle) Then
            colorCycle = Array(RGB(255, 0, 0), RGB(0, 255, 0), RGB(0, 0, 255))
        End If
         
        ' 找到当前颜色的索引并更新为下一个颜色
        Dim currentIndex As Integer
        For currentIndex = LBound(colorCycle) To UBound(colorCycle)
            If Target.Interior.Color = colorCycle(currentIndex) Then
                Exit For
            End If
        Next currentIndex
         
        ' 如果当前索引超出了颜色数组的范围（理论上不应该发生，除非单元格被手动设置了其他颜色）
        ' 则重置为第一个颜色
        If currentIndex > UBound(colorCycle) Then
            currentIndex = LBound(colorCycle)
        End If
         
        ' 应用下一个颜色
        Target.Interior.Color = colorCycle((currentIndex + 1) Mod (UBound(colorCycle) + 1))
         
        ' 取消双击后的默认编辑行为（可选）
        Cancel = True
    End If
End Sub
  
Private Sub Workbook_Open()
    ' 清除任何可能残留的颜色循环变量（虽然在这个特定例子中可能不是必需的，因为每次都会重新初始化）
    colorCycle = Empty
End Sub

ynzsvt

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   

复制代码

最初的梦想168

ynzsvt 发表于 2024-10-23 06:49

谢谢！！正确