Запуск макроса при изменении ячейки в определенном диапазоне VBA

Question

Я создал это вчера, и оно работало нормально, но сегодня оно больше не работает.Цель состоит в том, чтобы иметь раскрывающееся меню, которое учитывает Y и N.Если оператор выберет Y (скажем, в ячейке Y11), то поскольку ячейки под ним содержат формулу =IF($Y$11="Y","Y",""), он превратится в Y, и каждая ячейка под ним будет делать то же самое (цепная реакция).

Если оператор решит, что он неправильно указал Y, он может вернуться назад, щелкнуть N, и эта ячейка заменит исходную формулу.

Как я уже сказал, вчера это работало, а сейчас нет.Кто-нибудь видит слабые места в коде?Это вставляется в лист, а не модуль.

Private Sub Reverse_NewBatch_Mistake(ByVal Target As Range)
    If Not Application.Intersect(Target, Range("Y12:Y36")) Is Nothing Then
        If ActiveCell = "Y" Then
            'do nothing
        End If

        If ActiveCell = "N" Then
            variable = ActiveCell.Offset(-1, 0).Address
            ActiveCell.Formula = "=if(" & variable & "=""Y"",""Y"","""")"
        End If
    End If
End Sub

Answer 1

Вы можете достичь желаемого результата, используя событие Worksheet_Change, как показано ниже.

Просто поместите приведенный ниже код под рабочим листом, с которым вы хотите работать, код также устраняет необходимость для всех ячеек иметь формулыв них:

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range: Set rng = Range("Y12:Y36")
'declare and set the range you wish to react as a chain reaction
    If Target.Address = "$Y$11" Then 'if cell Y11 has changed value
        If Target.Value = "Y" Then 'if the value is "Y" then
            rng = "Y" 'set the whole range as "Y"
        Else
            rng = "" 'else empty the range
        End If
    End If
End Sub

ОБНОВЛЕНИЕ:

Исходя из комментариев, код ниже будет автоматически заполнять диапазон ниже ячейки, в которой был введен "Y", допоследний ряд на рнг:

Private Sub Worksheet_Change(ByVal Target As Range)
Application.EnableEvents = False
'disable events so the work we do below doesn't set the Change event again
    Dim ws As Worksheet: Set ws = Sheets("Sheet1")
    Dim rng As Range: Set rng = ws.Range("Y12:Y36")
    'declare and set the range you wish to react as a chain reaction
    Dim i As Long
    If Not Application.Intersect(Target, rng) Is Nothing Then
        For i = (Target.Row + 1) To (rng.Rows.Count + rng.Row - 1)
        'loop through from where the value was entered to the last row specified in rng
            If Target.Value = "Y" Then 'if value is "Y" then
                ws.Cells(i, "Y").Value = "Y" 'enter "Y" in the range below
            Else
                ws.Cells(i, "Y").Value = "" 'else empty cells below
            End If
        Next i
    End If
Application.EnableEvents = True
End Sub