Объединение нескольких макросов Worksheet_Change

Я пытаюсь объединить несколько макросов workheet_change (см. Код ниже). Моя цель заключается в том, что всякий раз, когда изменяется «целевой» диапазон (объединенная ячейка с раскрывающимся списком), диапазоны ниже (опять же, объединенные ячейки) будут очищены. Мне нужно сделать это, когда меняются разные МНОЖЕСТВЕННЫЕ ячейки, следовательно, коды изменения нескольких листов.Объединение нескольких макросов Worksheet_Change

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Intersect(Target, Range("J1:O1")) Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     Range("J2:O3").ClearContents 
     Range("D15:E15").ClearContents 
      Range("B16:E16").ClearContents 
       Range("B17:E19").ClearContents 
     Range("D20:E20").ClearContents 
      Range("B21:E21").ClearContents 
       Range("B22:E24").ClearContents 
     Range("D25:E25").ClearContents 
      Range("B26:E26").ClearContents 
       Range("B27:E29").ClearContents 
     Range("D30:E30").ClearContents 
      Range("B31:E31").ClearContents 
       Range("B32:E34").ClearContents 
     Range("B3:H14").ClearContents 
    Application.EnableEvents = True 
    End Sub 

    Private Sub Worksheet_Change(ByVal Target As Range) 
    If Intersect(Target, Range("J2:K2")) Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     Range("J3:K3").ClearContents 
    Application.EnableEvents = True 
    End Sub 

    Private Sub Worksheet_Change(ByVal Target As Range) 
    If Intersect(Target, Range("L2:M2")) Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     Range("L3:M3").ClearContents 
    Application.EnableEvents = True 
    End Sub 

    Private Sub Worksheet_Change(ByVal Target As Range) 
    If Intersect(Target, Range("N2:O2")) Is Nothing Then Exit Sub 
    Application.EnableEvents = False 
     Range("N3:O3").ClearContents 
    Application.EnableEvents = True 
    End Sub

источник

2015-09-09 Kelsey Marti

У вас есть все эти подводные лодки в одном модуле рабочего листа? –

Код ниже просто код скомпоновать в 1 Sub с несколькими If statements. Единственное изменение заключается в том, что If теперь является If Not, который будет обрабатывать код, если есть Intersect, а затем Exit sub.

Следующий код будет делать трюк:

Private Sub Worksheet_Change(ByVal Target As Range) 
    If Not Intersect(Target, Range("J1:O1")) Is Nothing Then 
     Application.EnableEvents = False 
     Range("J2:O3").ClearContents 
     Range("D15:E15").ClearContents 
     Range("B16:E16").ClearContents 
     Range("B17:E19").ClearContents 
     Range("D20:E20").ClearContents 
     Range("B21:E21").ClearContents 
     Range("B22:E24").ClearContents 
     Range("D25:E25").ClearContents 
     Range("B26:E26").ClearContents 
     Range("B27:E29").ClearContents 
     Range("D30:E30").ClearContents 
     Range("B31:E31").ClearContents 
     Range("B32:E34").ClearContents 
     Range("B3:H14").ClearContents 
     Application.EnableEvents = True 
     Exit Sub 
    End If 
    If Not Intersect(Target, Range("J2:K2")) Is Nothing Then 
     Application.EnableEvents = False 
     Range("J3:K3").ClearContents 
     Application.EnableEvents = True 
     Exit Sub 
    End If 
    If Not Intersect(Target, Range("L2:M2")) Is Nothing Then 
     Application.EnableEvents = False 
     Range("L3:M3").ClearContents 
     Application.EnableEvents = True 
     Exit Sub 
    End If 
    If Not Intersect(Target, Range("N2:O2")) Is Nothing Then 
     Application.EnableEvents = False 
     Range("N3:O3").ClearContents 
     Application.EnableEvents = True 
     Exit Sub 
    End If 
End Sub

источник

2015-09-09 13:19:37 DragonSamu

Великие умы думаю, я думаю. – user3819867

Private Sub Worksheet_Change(ByVal Target As Range) 
If Not Intersect(Target, Range("J1:O1")) Is Nothing Then 
    Application.EnableEvents = False 
     Range("J2:O3").ClearContents 
     Range("D15:E15").ClearContents 
      Range("B16:E16").ClearContents 
       Range("B17:E19").ClearContents 
     Range("D20:E20").ClearContents 
      Range("B21:E21").ClearContents 
       Range("B22:E24").ClearContents 
     Range("D25:E25").ClearContents 
      Range("B26:E26").ClearContents 
       Range("B27:E29").ClearContents 
     Range("D30:E30").ClearContents 
      Range("B31:E31").ClearContents 
       Range("B32:E34").ClearContents 
     Range("B3:H14").ClearContents 
    Application.EnableEvents = True 
End If 

If Not Intersect(Target, Range("J2:K2")) Is Nothing Then 
    Application.EnableEvents = False 
     Range("J3:K3").ClearContents 
    Application.EnableEvents = True 
End If 

If Not Intersect(Target, Range("L2:M2")) Is Nothing Then 
    Application.EnableEvents = False 
     Range("L3:M3").ClearContents 
    Application.EnableEvents = True 
End If 

If Not Intersect(Target, Range("N2:O2")) Is Nothing Then 
    Application.EnableEvents = False 
     Range("N3:O3").ClearContents 
    Application.EnableEvents = True 
End If 

End Sub

источник

2015-09-09 13:19:27 user3819867

Объединение нескольких макросов Worksheet_Change

ответ

Смежные вопросы