Макрос, который автоматически заполняет ячейку на основе выпадающего меню в Excel

Question

Мне нужна помощь для генерации макроса, который в основном дает значение "200000" на основе раскрывающегося меню в ячейке. Это раскрывающееся меню содержит два определенных значения (120 и 480). Если в выпадающем меню выбрано другое значение, у меня должна быть свобода записи любого значения, которое я хочу. Код, который я придумал, ниже

Private Sub Worksheet_Change(ByVal Target As Range)
If Target.Cells.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("$G$11")) Is Nothing Then
 Range("$B$20:$R$25,$Z$20:$AM$25").ClearContents
 End If

If Target.Cells.Count > 1 Then Exit Sub
 If Not Intersect(Target, Range("$G$11")) Is Nothing Then
 Range("$F$16:$Q$16,$R$15:$U$16,$V$16:$AA$16,$AB$15:$AM$16").ClearContents
 End If

If Range("I16") = 120 Or Range("I16") = 480 Then
        Range("F16") = 200000
    Else
        Range("F16") = ""
    End If
exitHandler:
  Application.EnableEvents = True
  Exit Sub


End Sub

Однако у меня есть другой макрос, который очищает все содержимое ячеек, из-за которого приведенный выше код вызывает ошибку. Любая помощь очень ценится.

Answer 1

Убедитесь, что вы не запускаете обработчик событий изнутри. Также стоит добавить обработчик ошибок, чтобы убедиться, что события не остались выключенными.

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim v

    On Error GoTo exitHandler

    If Target.Cells.CountLarge > 1 Then Exit Sub

    If Not Intersect(Target, Me.Range("G11")) Is Nothing Then
        Application.EnableEvents = False
        Me.Range("B20:R25,Z20:AM25,F16:Q16,R15:U16,V16:AA16,AB15:AM16").ClearContents
    End If

    If Not Intersect(Target, Me.Range("I16")) Is Nothing Then
        v = Target.Value
        Application.EnableEvents = False
        Me.Range("F16").Value = IIf(v = 120 Or v = 480, 200000, "")
    End If

exitHandler:
    Application.EnableEvents = True

End Sub

Answer 2

В основном вам просто нужно отключить события перед очисткой ячеек, чтобы код Change не срабатывал.

Я не уверен, как соотносится второй бит кода, поэтому может потребоваться некоторая корректировка.

Private Sub Worksheet_Change(ByVal Target As Range)

If Target.Cells.Count > 1 Then Exit Sub
    If Not Intersect(Target, Range("$G$11")) Is Nothing Then
        Application.EnableEvents = False
        Range("$B$20:$R$25,$Z$20:$AM$25").ClearContents
        Range("$F$16:$Q$16,$R$15:$U$16,$V$16:$AA$16,$AB$15:$AM$16").ClearContents
        If Range("I16") = 120 Or Range("I16") = 480 Then 'presumably belongs elswhere as just cleared I16 above?
            Range("F16") = 200000
        Else
            Range("F16").Clear
        End If
    End If
    Application.EnableEvents = True
exitHandler:
Application.EnableEvents = True
Exit Sub

End Sub