Несколько событий Worksheet_Change в коде VBA

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

Также вы можете использовать:

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

Answer 2

Основная проблема заключается в том, что изменение значения ячейки 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 3

Два события Worksheet_Change совершенно одинаковы, они представляют собой цикл вокруг диапазона, возвращая LCase().Таким образом, было бы неплохо создать для него отдельную подпрограмму, например:

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

The 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

Таким образом, вы можете делать обе вещи в одном и том же событии

Вы должны добавить 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