Question

我一直在尝试将2个宏组合成1个工作表，我只想用鼠标点击一下复选标记然后双击x我该怎么做？我附加了我使用它的宏是相同的公式：第二个宏的字符串=“C2：C80，E2：E80”和Target.Value =“r”。 Target.Cells.Counts = 2

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

    Const sCheckAddress As String = "B2:B80, D2:D80"

    Dim rngIntersect As Range

    If Target.Cells.Count = 1 Then

        On Error Resume Next
        Set rngIntersect = Intersect(Me.Range(sCheckAddress), Target)
        On Error GoTo 0

        If Not (rngIntersect Is Nothing) Then
            Target.Font.Name = "Marlett"
        Target.Value = "a"


        End If

    End If

End Sub

Answer 1

您想要做的事情必须分成两个独立的事件：

Private Sub Worksheet_BeforeDoubleClick(ByVal Target As Range, Cancel As Boolean)
    Application.EnableEvents = False
    Const sCheckAddress As String = "B2:B80, D2:D80"

    Dim rngIntersect As Range

    If Target.Cells.Count = 1 Then

        On Error Resume Next
        Set rngIntersect = Intersect(Me.Range(sCheckAddress), Target)
        On Error GoTo 0

        If Not (rngIntersect Is Nothing) Then
            Target.Font.Name = "Marlett"
        Target.Value = "r"
        ' I'm not overly happy with this next line, but at least it gets you out of activating the cell.
        Target.Offset(0, 1).Select
        End If

    End If
    Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False
    Const sCheckAddress As String = "B2:B80, D2:D80"

    Dim rngIntersect As Range

    If Target.Cells.Count = 1 Then

        On Error Resume Next
        Set rngIntersect = Intersect(Me.Range(sCheckAddress), Target)
        On Error GoTo 0

        If Not (rngIntersect Is Nothing) Then
            Target.Font.Name = "Marlett"
        Target.Value = "a"


        End If

    End If
Application.EnableEvents = True
End Sub

Answer 2

@ sous2817发布了一个很好的答案。我想扩展这个想法 - 但是如果你喜欢这种方法，请给@ sous2817以答案，因为我所做的只是改变一点。

每当您重复代码时，最好考虑如何对其进行子例程或将其中的一部分转换为可以使用和重用的函数。

这会划分您的代码，使其更易读（通常），如果您的文件结构稍后需要更改代码，则最重要的是使维护更容易。例如，在两个子例程中都有许多共同元素：

sCheckAddress表示范围地址的字符串变量
检查target.cells.count = 1
检查目标是否与`sCheckAddress

我将这些常用元素放在一个函数中，该函数告诉子例程何时对Target执行操作。虽然这对于这个范围的项目来说似乎微不足道，但是当你在更大更复杂的VBA编程上工作时，这是一个很好的习惯。

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

Application.EnableEvents = False

If UpdateCell(Target) Then  `<~~ Use a custom function to determine whether to act on this cell.
    With Target
        .Font.Name = "Marlett"
        .Value = "r"
        .Offset(0, 1).Select
    End With
End If

Application.EnableEvents = True

End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
Application.EnableEvents = False

If UpdateCell(Target) Then `<~~ Use a custom function to determine whether to act on this cell.
    With Target
        .Font.Name = "Marlett"
        .Value = "r"
    End With
End If

Application.EnableEvents = True

End Sub

这是检查以确保您的Target范围仅为一个单元格的函数。它还会执行第二次检查，以确保Target能够检测到您的sCheckAddress。只有当传递了这两个条件时，它才返回值True ，然后允许事件宏更新Target。

Private Function UpdateCell(rng As Range) As Boolean Const sCheckAddress As String = "B2:B80, D2:D80" 'Establish conditions that return "FALSE" If rng.Cells.Count <> 1 Then Exit Function '<~~ Make sure only one cell triggered the event.' If Intersect(Me.Range(sCheckAddress), rng) Is Nothing Then Exit Function '<~~ Make sure the cell is in your sCheckAddress Range.' UpdateCell = True End Function

1个工作表中的2个宏，单击以选中复选标记，然后双击x

2 个答案: