更改事件代码在堆栈空间外生成运行时错误“28”答案

【问题标题】：Change event code generates Run-Time error '28' out of stack space更改事件代码在堆栈空间外生成运行时错误“28”
【发布时间】：2019-05-01 06:23:00
【问题描述】：

此代码在 Excel 2010 中有效，但我现在拥有 Excel 2013。

错误是

运行时错误“28”超出堆栈空间，运行时错误“2147417848 (80010108)”：对象“范围”的方法“值”失败

代码如下。

Private Sub Worksheet_Change(ByVal Target As Range)

Dim rng As Range, r As Range, rv As Long

If Not Intersect(Target, Range("C77:AD81")) Is Nothing Then
    Set rng = Intersect(Target, Range("C77:AD81"))
    For Each r In rng

        'Peak Flow Doctor Warning

        Select Case r.Value
            Case 180
                MsgBox "''PEAK FLOW CRITICAL AT 180L/MIN''" & vbCrLf & "''PREDNISONE PROBABLY REQUIRED''" & vbCrLf & "''MAKE DOCTOR'S APPOINTMENTS ASAP''", vbInformation, "WARNING"
            Case 120
                MsgBox "''PEAK FLOW CRITICAL AT 120L/MIN''" & vbCrLf & "''MAKE URGENT DOCTOR'S APPOINTMENTS''" & vbCrLf & "''OR GO TO A&E IMMEDIATELY''", vbInformation, "CRITICAL WARNING"
            Case Is >= 525
                MsgBox "''CHECK OR TEST PEAK FLOW METER''" & vbCrLf & "''IT MAY BE FAULTY AND GIVING FALSE HIGH's''", vbInformation, "WARNING"
        End Select
    Next r
End If
   'OraKinetics needs to change to (Target, Range("C95:AD95"))
If Not Intersect(Target, Range("C93:AD93")) Is Nothing Then
    Set rng = Intersect(Target, Range("C93:AD93"))
    For Each r In rng

        'Weight Gain Warning

        Select Case r.Value
            Case 90
                MsgBox "''LIKELY TO EXACERBATE COPD SYMPTOMS''" & vbCrLf & "''CHRONIC ASTHMA OR EMPHYSEMA PROBABLE''", vbCritical, "WARNING"
            Case 95
                MsgBox "''IF SWELLING IN ANKLES PROBABLE FLUID RETENTION''" & vbCrLf & "''POSSIBILITY OF HEART FAILURE IF UNATTENDED''", vbCritical, "CRITICAL WARNING"
        End Select
    Next r
End If

'Change Best Peak Flow and Date Achieved

ActiveSheet.Unprotect Password:="asthma"
If Range("R7").Value > Range("F7").Value Then
    Range("R7").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K7") = Date
    Application.CutCopyMode = False
    ActiveSheet.Protect Password:="asthma", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If
End Sub

【问题讨论】：

看看这个link和这个one。很可能您的 VBA 正在修改一个单元格，该单元格触发其他单元格的计算，然后再次触发 VBA，形成一个闭环。这种行为可能会填满您的堆栈空间。尝试确定这一点，或者使用 Application.EnableEvents = False / Application.EnableEvents = True 将部分 VBA 代码括起来，直到您在工作表中找到问题。
Runtime error '28': Out of stack space in Excel VBA的可能重复
sɐunıɔןɐqɐp 使用您的代码附件建议我发现问题是“如果不相交（目标，范围（“C77：AD81”））则什么都没有”代码。但是如果我将其删除，则 MsgBox 不会激活，并且我不确定如何纠正 b 问题。

标签： excel vba

【解决方案1】：

如果您在 _Change 事件中创建更改，那么您需要在更改之前禁用事件以防止无限循环。

Application.EnableEvents = False

ActiveSheet.Unprotect Password:="asthma"
If Range("R7").Value > Range("F7").Value Then
    Range("R7").Select
    Selection.Copy
    Range("F7").Select
    Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
        :=False, Transpose:=False
    Range("K7") = Date
    Application.CutCopyMode = False
    ActiveSheet.Protect Password:="asthma", DrawingObjects:=True, Contents:=True, Scenarios:=True
End If

Application.EnableEvents = True

【讨论】：