VBA技术问题：如何避免多整数场景下的递归栈溢出与重复MsgBox弹窗

咱们先拆解你遇到的两个核心问题，再一步步修改代码来解决：

问题根源分析 #

1. 栈溢出（Out of Stack Space）：
   你的Worksheet_Change事件里用了Application.Undo，执行Undo操作会再次触发Worksheet_Change事件，相当于事件自己调用自己，形成无限递归，直到栈空间被耗尽，就会抛出栈溢出错误。

2. 重复MsgBox弹窗+逻辑bug：

   • 原代码拆分内容到arr数组后，没有遍历数组元素，反而用了未赋值的变量a，导致校验逻辑完全失效。
   • 就算你遍历了数组，原来的逻辑是每个元素都弹一次MsgBox，自然会出现重复弹窗的问题。

修改后的完整代码 #

IsItGood函数（优化版） #

Public Function IsItGood(aWord As Variant) As Boolean
    Dim s As String
    Dim pattern As String ' 修正原代码的变量名拼写错误（patern→pattern）
    Dim i As Integer
    
    s = "|"
    ' 用更高效的方式生成合法校验集合，替代循环拼接
    pattern = s & Join(Application.Transpose(GenerateNumbers(1, 100)), s) & s _
             & Join(Application.Transpose(GenerateCNumbers(1, 10)), s) & s _
             & "merge|complete framed|width|border left|border right" & s
    
    ' 处理空值、非字符串情况，避免报错
    If IsEmpty(aWord) Or Not IsString(aWord) Then
        IsItGood = False
        Exit Function
    End If
    
    Dim tmp As String
    tmp = s & Trim(aWord) & s ' 去掉内容前后空格，避免因空格导致校验失败
    
    ' 忽略大小写校验，如需严格区分可去掉vbTextCompare参数
    IsItGood = InStr(1, pattern, tmp, vbTextCompare) > 0
End Function

' 辅助函数：生成1到n的数字数组
Private Function GenerateNumbers(startNum As Integer, endNum As Integer) As Variant
    Dim arr() As String
    ReDim arr(startNum To endNum)
    Dim i As Integer
    For i = startNum To endNum
        arr(i) = CStr(i)
    Next i
    GenerateNumbers = arr
End Function

' 辅助函数：生成C1到Cn的字符串数组
Private Function GenerateCNumbers(startNum As Integer, endNum As Integer) As Variant
    Dim arr() As String
    ReDim arr(startNum To endNum)
    Dim i As Integer
    For i = startNum To endNum
        arr(i) = "C" & CStr(i)
    Next i
    GenerateCNumbers = arr
End Function

' 辅助函数：判断变量是否为字符串类型
Private Function IsString(v As Variant) As Boolean
    IsString = VarType(v) = vbString
End Function

Worksheet_Change事件过程（修复递归与弹窗问题） #

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim arr As Variant
    Dim a As Variant
    Dim badItems As Collection
    Dim msgText As String
    
    ' 仅处理G3:G19区域的单个单元格修改（支持多选可调整此判断）
    If Intersect(Range("G3:G19"), Target) Is Nothing Or Target.Cells.Count > 1 Then
        Exit Sub
    End If
    
    ' 关闭事件触发，避免Undo或修改单元格导致递归调用
    Application.EnableEvents = False
    
    ' 确保出错时也能恢复事件触发状态
    On Error GoTo Cleanup
    
    Set badItems = New Collection
    arr = Split(Target.Value, " ") ' 拆分单元格内容为数组
    
    ' 遍历所有拆分后的元素，收集非法内容
    For Each a In arr
        a = Trim(a) ' 去掉元素前后空格
        If a <> "" Then ' 跳过空字符串（比如连续空格拆分出的空值）
            If Not IsItGood(a) Then
                badItems.Add a
            End If
        End If
    Next a
    
    ' 生成单次弹窗的文本内容
    msgText = "单元格 " & Target.Address(0, 0) & vbCrLf
    If badItems.Count = 0 Then
        msgText = msgText & "所有内容均合法 ✅"
        MsgBox msgText, vbInformation
    Else
        msgText = msgText & "以下内容不合法 ❌：" & vbCrLf & Join(GetCollectionArray(badItems), vbCrLf)
        MsgBox msgText, vbExclamation
        Application.Undo ' 仅存在非法内容时执行撤销
    End If

Cleanup:
    ' 必须恢复事件触发，否则后续单元格修改不会触发事件
    Application.EnableEvents = True
    ' 捕获并提示错误（如果有）
    If Err.Number <> 0 Then
        MsgBox "发生错误：" & Err.Description, vbCritical
    End If
End Sub

' 辅助函数：将Collection转换为数组，方便用Join拼接文本
Private Function GetCollectionArray(col As Collection) As Variant
    Dim arr() As String
    ReDim arr(1 To col.Count)
    Dim i As Integer
    For i = 1 To col.Count
        arr(i) = col(i)
    Next i
    GetCollectionArray = arr
End Function

关键改动说明 #

1. 解决栈溢出：

   • 在事件开头添加Application.EnableEvents = False，关闭事件触发机制，避免Undo操作再次触发Worksheet_Change形成递归。
   • 用On Error GoTo Cleanup确保无论是否出错，最后都会恢复事件触发状态，防止后续单元格修改失效。

2. 解决重复弹窗：

   • 遍历拆分后的数组元素，将所有非法内容收集到Collection中，最后一次性生成弹窗文本，只弹出一次提示框。
   • 处理了空字符串（比如连续空格拆分出的空值），避免无效校验。

3. IsItGood函数优化：

   • 修正了变量名拼写错误，让代码更规范。
   • 用辅助函数生成合法集合，替代原有的循环拼接，代码更简洁高效。
   • 增加空值、非字符串的判断，避免运行时错误。
   • 加入Trim处理内容前后空格，避免因输入空格导致的校验失败。

内容的提问来源于stack exchange，提问作者Hris