如何优化运行缓慢且致Excel崩溃的VBA testing_rows子程序？

原代码的核心性能问题在于循环中逐行读写单元格，这会频繁触发Excel的界面刷新和对象交互，处理大量数据时极易导致卡顿甚至崩溃。以下是针对性的优化方案：

优化后的代码 #

Sub testing_rows_optimized()
    Dim ws As Worksheet
    Dim nbTxt As Integer
    Dim i As Integer
    Dim gp_lastrow As Long
    Dim lastRow As Long
    Dim my_char As String
    Dim dataArr As Variant
    Dim resultArr As Variant
    
    ' 指定目标工作表
    Set ws = ThisWorkbook.Worksheets("Sheet4")
    
    ' 获取有效数据行（根据实际需求选择其中一个作为循环上限）
    gp_lastrow = ws.Range("A" & ws.Rows.Count).End(xlUp).Row
    ' lastRow = ws.Range("A:A").Cells.SpecialCells(xlCellTypeConstants).Count
    
    ' 禁用Excel后台操作，大幅提升运行速度
    With Application
        .ScreenUpdating = False
        .EnableEvents = False
        .Calculation = xlCalculationManual
    End With
    
    ' 将A列数据批量读入内存数组（减少单元格交互次数）
    dataArr = ws.Range("A2:A" & gp_lastrow).Value
    ' 初始化结果数组
    ReDim resultArr(1 To UBound(dataArr, 1), 1 To 1)
    my_char = "-"
    
    ' 在内存数组内完成计算，避免逐行读写单元格
    For i = 1 To UBound(dataArr, 1)
        If Not IsEmpty(dataArr(i, 1)) Then
            resultArr(i, 1) = (Len(dataArr(i, 1)) - Len(Replace(dataArr(i, 1), my_char, ""))) / Len(my_char)
        Else
            resultArr(i, 1) = 0 ' 空单元格默认返回0，可根据需求调整
        End If
    Next i
    
    ' 将结果数组批量写入BB列
    ws.Range("BB2:BB" & gp_lastrow).Value = resultArr
    
    ' 恢复Excel默认设置
    With Application
        .ScreenUpdating = True
        .EnableEvents = True
        .Calculation = xlCalculationAutomatic
    End With
    
    Set ws = Nothing
End Sub

关键优化点说明 #

• 批量数组操作：将A列数据一次性读入内存数组，计算完成后再将结果批量写入单元格，彻底避免循环中频繁的单元格读写，这是提升性能的核心措施。
• 禁用后台干扰：关闭屏幕刷新、事件触发和自动计算，减少Excel运行时的额外开销。
• 严格变量声明：所有变量均显式声明类型，避免隐式类型转换带来的性能损耗和潜在错误。
• 限定工作表范围：所有单元格操作绑定到指定工作表对象，避免默认引用ActiveSheet导致的意外错误。
• 灵活循环边界：根据实际有效数据行设置循环范围，避免处理空行或无效行。

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