Цикл Worksheet_Change заставляет Excel перестать отвечать

Question

У меня есть сценарий VBA, поэтому, когда значение ячейки равно «N / A», оно смещается на одну ячейку вправо и также записывает «N / A».Сценарий работает, но он заставляет Excel перестать отвечать на запросы.Я хочу, чтобы он делал это каждый раз, когда вносится изменение в диапазон ячеек, поэтому я сделал его «Worksheet_Change».Моя мысль (что я могу и, вероятно, ошибаюсь) заключается в том, что она должна делать это при каждом изменении листа, вызывающем «выгорание» программы.

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim i As Long
Set rng = Range("E267:E1000")
For Each cell In rng
    'test if cell is empty
    If cell.Value = "N/A" Then
        'write to adjacent cell
        cell.Offset(0, 1).Value = "N/A"
    End If
Next  
End Sub

Answer 1

Если вы физически меняете ячейку, вы можете выбрать диапазон изменяемых ячеек.Например, приведенный ниже код срабатывает каждый раз, когда вы физически меняете ячейку в указанном диапазоне.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Count > 1 Then Exit Sub    ' this stops code error if more than one cell is changed at once

    If Not Application.Intersect(Target, Me.Range("E267:E1000")) Is Nothing Then    ' indicates the Target range
        If Target.Value = "N/A" Then
            Target.Offset(, 1) = Target.Value
        End If
    End If

End Sub

Answer 2

Если вы должны использовать VBA для этого, вы можете попробовать это.Отключите события в вашем цикле, когда вносятся изменения, чтобы убедиться, что вы не застряли в бесконечном цикле.Кроме того, если ваш диапазон является динамическим, я настоятельно рекомендую заменить нижнюю границу (E1000) динамической переменной, которая отслеживает последнюю строку в вашем наборе данных, чтобы минимизировать количество циклов, выполняемых макросом.

Например, если ваш макрос находится на листе, вы можете использовать его как нижнюю границу диапазона, которая тогда будет set rng=Range("E267:E" & LROW)

Dim LROW as Long
LROW = Range("E" & Rows.Count).End(xlUp).Row 

Макрос

Private Sub Worksheet_Change(ByVal Target As Range)
Dim rng As Range
Dim i As Long
Set rng = Range("E267:E1000")
For Each cell In rng
Application.Enable Events = False
    'test if cell is empty
    If cell.Value = "N/A" Then
        'write to adjacent cell
        cell.Offset(0, 1).Value = "N/A"
    End If
Application.EnableEvents=True
Next  
End Sub