十万行以上Excel VBA插入空行宏失效问题求助

问题背景 #

实现需求：当当前行A列（Level）数值与上一行不连续且数值不同时，插入空行。
运行现象：1万行以内数据处理正常；超过1万行时，宏无任何反应、无报错，仅获取数据但未粘贴转换后的结果。

核心排查与修复思路 #

1. 修复GoTo Last的强制终止逻辑

原代码中，若某一行的上一行A列值非数值，会直接通过GoTo Last跳到宏末尾，设置Cells(1,4).Value="1"后终止执行，且无任何提示，容易被误认为“无响应”。
修复方案：替换GoTo Last为跳过当前行的逻辑，避免终止整个循环：

' 替换原Else块的GoTo Last
Else
    ' 非数值行，直接复制当前行，跳过空行判断
    r = r + 1
    For j = 1 To ColCnt
        arrRes(r, j) = arrData(i, j)
    Next j
    GoTo NextIteration ' 跳转到循环末尾，进入下一次迭代
End If

' 在循环Next i前添加标签
NextIteration:
Next i

2. 优化数组内存分配

原代码ReDim arrRes(1 To UBound(arrData) * 2, 1 To ColCnt)按最大可能行数（原行数*2）分配内存，当数据量超1万行时，会占用不必要的内存，可能触发隐性内存溢出。
优化方案：先遍历一次数据统计需要插入的空行总数，再精准分配数组大小：

' 在获取arrData后，先统计空行数量
Dim emptyRowCount As Long
emptyRowCount = 0
For i = LBound(arrData) + 1 To UBound(arrData)
    a = arrData(i, 1)
    b = arrData(i - 1, 1)
    If IsNumeric(b) Then
        c = b + 1
        If Not (a = b Or a = c) Then
            emptyRowCount = emptyRowCount + 1
        End If
    End If
Next i
' 精准定义结果数组大小
ReDim arrRes(1 To UBound(arrData) + emptyRowCount, 1 To ColCnt)

3. 修正变量类型与溢出风险

原代码中lastRow未声明为Long，当行数超65536时会触发Integer溢出；a,b,c声明为Long，若A列存在非整数或超大数值，会导致类型转换错误。
修复方案：

' 修正变量声明
Dim arrData As Variant, arrRes As Variant, lastRow As Long, ColCnt As Long
Dim a As Variant, b As Variant, c As Long ' a,b改为Variant兼容非数值

4. 排查数据写入逻辑

超大量数据写入时，需确认写入范围正确，且清空旧数据避免干扰：

' 在写入前清空目标区域旧数据
Range("A6:S" & Rows.Count).ClearContents
' 写入数组数据
Range("A6").Resize(r, ColCnt).Value = arrRes
' 增加调试弹窗确认r值
MsgBox "处理完成，共生成" & r & "行数据"

5. 脱离Workbook_Open事件测试

打开工作簿时的宏可能受Excel安全策略或文件加载阻塞影响，建议将宏代码移到普通模块，手动执行测试，排除事件自身的限制。

原代码 #

Private Sub Workbook_Open()
    CarryOn = MsgBox("Do you want to run a macro that will format the report?", vbYesNo, "Report Formatting Automation")
    If CarryOn = vbYes Then
     'Backup report
    Sheets("Where Used Report").Copy after:=Sheets("Where Used Report")
    ActiveSheet.Name = "Original Where Used Report"
    Sheets("Where Used Report").Activate

    Dim i As Long, j As Long, r As Long
    Dim arrData, arrRes, lastRow, ColCnt As Long
    Dim a, b, c As Long
    Dim numCheck
    
    'macro on open file event
    If Cells(1, 4).Value = "1" Then
    'do not run open macro if already run once
    Else
    lastRow = Cells(Rows.Count, "A").End(xlUp).Row
    arrData = Range("A6:S" & lastRow).Value
    ColCnt = UBound(arrData, 2)
    ReDim arrRes(1 To UBound(arrData) * 2, 1 To ColCnt)
    r = 1
    For j = 1 To ColCnt
        arrRes(r, j) = arrData(1, j)
    Next j
    MsgBox LBound(arrData)
    MsgBox UBound(arrData)
    For i = LBound(arrData) + 1 To UBound(arrData)
    a = arrData(i, 1)
    b = arrData(i - 1, 1)
    
    numCheck = IsNumeric(b)
    
    If numCheck = True Then
    c = arrData(i - 1, 1) + 1
    Else
   'No where used component
   GoTo Last
   End If
        If a = b Or a = c Then
           'MsgBox "No line break"
            r = r + 1
        Else
            'MsgBox "Need a line break"
            r = r + 2
        End If
        
        For j = 1 To ColCnt
            arrRes(r, j) = arrData(i, j)
        Next j
    Next i
        'MsgBox "Copy start"
        Range("C5:C" & r).NumberFormat = "0000"
        Range("A6").Resize(r, ColCnt).Value = arrRes
        'MsgBox "Copy Complete"
        Cells(1, 4).Value = "1"  
   End If   
   Else
   ' MsgBox ("Report format is to be kept same."
End If
Last:
Cells(1, 4).Value = "1"
End Sub

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