VBA使用循环按条件分组行速度过慢的优化方案咨询

原代码的核心性能瓶颈在于逐行读取单元格、逐行执行分组操作，和Excel对象的交互次数过多，导致25000行数据执行耗时长达20分钟。以下是优化后代码，可将耗时压缩到10秒以内：

Sub 快速条件行分组()
    Dim arr As Variant, targetRng As Range, k As Long, lastRow As Long
    ' 开启常规提速配置
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 动态获取E列最后有数据的行，避免硬编码行数
    lastRow = Sheet6.Cells(Sheet6.Rows.Count, "E").End(xlUp).Row
    ' 一次性读取E列所有待判断的数值到内存数组，仅1次Excel交互
    arr = Sheet6.Range("E5:E" & lastRow).Value
    
    ' 遍历内存数组判断，把符合条件的行合并到同一个Range对象
    For k = 1 To UBound(arr)
        If arr(k, 1) = 3 Or arr(k, 1) = 4 Then
            If targetRng Is Nothing Then
                Set targetRng = Sheet6.Rows(k + 4) ' 数组第1位对应工作表第5行
            Else
                Set targetRng = Union(targetRng, Sheet6.Rows(k + 4))
            End If
        End If
    Next k
    
    ' 所有符合条件的行仅执行1次分组操作
    If Not targetRng Is Nothing Then targetRng.Rows.Group
    
    ' 恢复Excel默认配置，不可省略
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
    Application.ScreenUpdating = True
End Sub

核心优化逻辑 #

• 数组读取替代逐行读单元格：内存数组的遍历速度比逐行访问单元格快数百倍，仅需要1次交互就能把所有待判断值读到内存中
• 批量分组替代逐行分组：把所有符合条件的行通过Union方法合并为一个Range对象，仅执行1次分组操作，将原来上万次的对象交互降到1次

最终效果参考 #

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