0

我一直在尝试将 2 个宏组合到 1 个工作表中，我只想使用鼠标单击以选中复选标记并双击 x 我该怎么做？我附加了我使用的宏，它是相同的公式：第二个宏的 string = "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
4

2 回答 2

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
于 2013-04-20T02:11:57.390 回答
0

@sous2817 发布了一个很好的答案。我想扩展这个想法——但如果你喜欢这个方法，请给 @sous2817 的答案，因为我所做的只是稍微修改一下。

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

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

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

我将这些公共元素放在一个函数中，该函数告诉子例程何时对目标采取行动。虽然这在这个范围的项目中看起来微不足道，但在您处理更大和更复杂的 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
于 2013-04-20T02:51:58.763 回答