Как преодолеть «Ошибка нехватки места в стеке» в Excel?

Question

Я пытаюсь очистить данные из ячейки от A5 до A10, если счет в A3 не равен 6. Я написал «оператор If», но он выдает ошибку из стека. Как мне преодолеть эту ошибку

Я пробовал "if if", но он выдает ошибку.

Dim Count As Integer
Dim BundleDup As Integer
Dim duplicateall As Integer
Dim SAPError As Integer

Private Sub Worksheet_Change(ByVal Target As Range)
    Count = Range("A3").Value
    BundleDup = Range("B3").Value
    duplicateall = Range("C3").Value
    SAPError = Range("D3").Value

    If Target.Address = "$A$10" And Count = 6 And BundleDup = 0 And duplicateall = 0 And SAPError = 0 Then

        newHour = Hour(Now())
        newMinute = Minute(Now())
        newSecond = Second(Now()) + 3
        waitTime = TimeSerial(newHour, newMinute, newSecond)
        Application.Wait waitTime
        Call MoveData
    End If

    If Count <> 6 Then
        Call ClearData
    End If

End Sub

Код работает нормально, если я не использую это

 If Count <> 6 Then
        Call ClearData
    End If

Но как только я воспользуюсь этим и введу значение в A5 - A10, он очистит данные, но застрянет и выдаст ошибку.

Модуль ClearData включает следующий код:

Sub ClearData()
'
' ClearData Macro
'

'
    Range("A5:A10").Select
    Range("A10").Activate
    Selection.ClearContents
    Range("A5").Select
End Sub

Answer 1

Вот как следует обрабатывать эту ситуацию:

    Public ClearingData As Boolean  'initializes natively to "False"

    Private Sub Worksheet_Change(ByVal Target As Range)
    If ClearingData Then Exit Sub 'stops the recursive loop
    ClearingData = True

    Count = Range("A3").Value
    BundleDup = Range("B3").Value
    duplicateall = Range("C3").Value
    SAPError = Range("D3").Value

    If Target.Address = "$A$10" And Count = 6 And BundleDup = 0 And duplicateall = 0 And SAPError = 0 Then

        newHour = Hour(Now())
        newMinute = Minute(Now())
        newSecond = Second(Now()) + 3
        waitTime = TimeSerial(newHour, newMinute, newSecond)
        Application.Wait waitTime
        Call MoveData
    End If

    If Count <> 6 Then
        Call ClearData 'Here's where the recursive loop gets created.
    End If

    ClearingData = False

    End Sub

Это предотвращает запуск рекурсивного цикла и по-прежнему оставляет события включенными. Код полностью обрабатывает конкретную ситуацию внутри функции, избегая неожиданных результатов, которые могут повлиять на другие функции.

Если функция «MoveData» изменила выбор ячейки, и у вас было вызвано событие «Worksheet_SelectionChange», отключение событий предотвратит вызов этого события. Используя вышеупомянутую логику, событие все равно будет вызвано. Если вы хотите предотвратить вызов «Worksheet_SelectionChange» из этой функции, просто включите строку «If ClearingData Then Exit Sub» в начале события «Worksheet_SelectionChange».

Извините, я использовал термин "Global" вместо "Public" в моих комментариях выше.

Answer 2

Просто добавим немного к комментарию Рори - ваша проблема в том, что вы создали бесконечный цикл в вашем коде.

С очень высокого уровня происходит то, что происходит:

1. You change a value on your worksheet
2. The Worksheet_Change() code is called
3. This code then changes something on the same worksheet
4. This change causes the Worksheet_Change() code to run again
5. This code then changes something on the same worksheet
6. This change causes the Worksheet_Change() code to run again
7. This code then changes something on the same worksheet
8. This change causes the Worksheet_Change() code to run again
9.This code then changes something on the same worksheet

   (you get the picture...)

Чтобы обойти это, вам нужно отключить любые дальнейшие события от вызова в вашем коде:

Private Sub Worksheet_Change(ByVal Target As Range)

    Application.EnableEvents = False '// stop further events from firing

    Count = Range("A3").Value
    BundleDup = Range("B3").Value
    duplicateall = Range("C3").Value
    SAPError = Range("D3").Value

    If Target.Address = "$A$10" And Count = 6 And BundleDup = 0 And duplicateall = 0 And SAPError = 0 Then

        newHour = Hour(Now())
        newMinute = Minute(Now())
        newSecond = Second(Now()) + 3
        waitTime = TimeSerial(newHour, newMinute, newSecond)
        Application.Wait waitTime
        Call MoveData
    End If

    If Count <> 6 Then
        Call ClearData
    End If

    Application.EnableEvents = True '// re-enable events

End Sub

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