vba 代码中的多个 Worksheet_Change 事件

Question

我在合并两个 Worksheet_Change 事件时遇到问题 - 我可以从大师那里得到一些建议吗？

代码的目的是将给定的单元格范围中的任何大写文本转换为小写，但显然我不能有两个事件。

我试过将两者都复制到同一个 Worksheet_Change 中，但 Excel 变得疯狂并崩溃了。

范围 1：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim ccr As Range
    Set ccr = Range("C6")
    For Each Cell In ccr
    Cell.Value = LCase(Cell)
    Next Cell
End Sub

范围 2：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim acr As Range
    Set acr = Range("C9:G9")
    For Each Cell In acr
    Cell.Value = LCase(Cell)
    Next Cell
End Sub

非常感谢

Answer 1

主要问题是更改单元格值Cell.Value将立即触发另一个Worksheet_Change 。 您需要Application.EnableEvents = False来防止这种情况。

此外，我建议使用Intersect以便代码仅在实际更改的单元格上运行。

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))

    If Not AffectedRange Is Nothing Then
        Application.EnableEvents = False 'pervent triggering another change event

        Dim Cel As Range
        For Each Cel In AffectedRange.Cells
            Cel.Value = LCase$(Cel.Value)
        Next Cel

        Application.EnableEvents = True 'don't forget to re-enable events in the end
    End If
End Sub

---

除了@Frank Ball 的评论，包括错误处理：

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim AffectedRange As Range
    Set AffectedRange = Intersect(Target, Target.Parent.Range("C6, C9:G9"))

    Application.EnableEvents = False 'pervent triggering another change event
    On Error GoTo ERR_HANDLING

    If Not AffectedRange Is Nothing Then
        Dim Cel As Range
        For Each Cel In AffectedRange.Cells
            Cel.Value = LCase$(Cel.Value)
        Next Cel
    End If

    On Error GoTo 0

    'no Exit Sub here!
ERR_HANDLING:
    Application.EnableEvents = True 

    If Err.Number <> 0 Then
        Err.Raise Err.Number, Err.Source, Err.Description, Err.HelpFile, Err.HelpContext
    End If
End Sub

Answer 2

像这样你可以在同一个事件中做这两件事

您必须在开始时添加Application.EnableEvents = False以避免竞争条件。

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

    Dim ccr As Range, acr as Range

    Set ccr = Range("C6")
    For Each Cell In ccr
      Cell.Value = LCase(Cell)
    Next Cell

    Set acr = Range("C9:G9")
    For Each Cell In acr
      Cell.Value = LCase(Cell)
    Next Cell
 Application.EnableEvents = True

End Sub

Answer 3

两个Worksheet_Change事件完全相同，它们是围绕一个范围的循环，返回LCase() 。 因此，像这样为它制作一个单独的 Sub 是一个好主意：

Sub FixRangeLCase(rangeToFix As Range)        
    Dim myCell As Range
    For Each myCell In rangeToFix
        myCell.Value2 = LCase(myCell.Value2)
    Next myCell    
End Sub

然后，将 Worksheet_Change 事件引用到它。 至于Worksheet_Change事件非常“昂贵”，总是运行，最好只在特定目标单元格更改时运行它，否则退出程序 - If Intersect(Target, Range("C6"), Range("C9:G9")) Is Nothing Then Exit Sub

需要Application.EnableEvents = False来禁用事件。 最后它被设置回True 。

Private Sub Worksheet_Change(ByVal Target As Range)

    If Not Intersect(Target, Range("C6"), Range("C9:G9")) Is Nothing Then Exit Sub
    Application.EnableEvents = False
    FixRangeLCase Range("C6")
    FixRangeLCase Range("C9:G9")
    Application.EnableEvents = True

End Sub

Answer 4

你也可以使用：

Option Explicit

Private Sub Worksheet_Change(ByVal Target As Range)

    Dim rng As Range, cell As Range

    Application.EnableEvents = False

        If Not Intersect(Target, Range("C6")) Is Nothing Or Not Intersect(Target, Range("C9:G9")) Is Nothing Then
            Set rng = Range("C9:G9", "C6")

            For Each cell In rng
                cell.Value = LCase(cell.Value)
            Next
        End If

    Application.EnableEvents = True

End Sub