列值变化时插入空白行：现有VBA代码效率低，求高效方案

原代码在处理大量数据时效率低下，核心问题是逐行循环插入行——每次插入操作都会触发Excel的界面重绘、公式计算等后台操作，且循环中频繁访问单元格对象，累积开销极大。以下是针对性的优化方案：

优化思路 #

• 批量定位所有需要插入空白行的位置，一次性完成插入操作，避免逐行操作的重复开销
• 关闭Excel的屏幕更新、自动计算和事件触发，减少后台资源消耗
• 使用Long类型替代Integer，避免行数超过32767时的溢出错误
• 明确指定工作表对象，避免依赖ActiveSheet导致的潜在问题

优化后的代码 #

Public Sub SplitRangesOptimized()
    Dim ws As Worksheet
    Dim lastRow As Long
    Dim customerCol As Long
    Dim insertRows As Collection
    Dim i As Long
    
    ' 初始化对象和参数
    Set ws = ThisWorkbook.Sheets("data")
    customerCol = ws.Range("E2").Column ' Customer ID所在列
    lastRow = ws.Cells(ws.Rows.Count, customerCol).End(xlUp).Row ' 获取最后一行
    
    ' 创建集合存储需要插入行的位置
    Set insertRows = New Collection
    
    ' 从下往上遍历，避免插入后行号偏移
    For i = lastRow To 3 Step -1
        If ws.Cells(i, customerCol).Value <> ws.Cells(i - 1, customerCol).Value Then
            insertRows.Add i ' 记录当前行的上方需要插入空白行
        End If
    Next i
    
    ' 关闭Excel后台操作，提升速度
    With Application
        .ScreenUpdating = False
        .Calculation = xlCalculationManual
        .EnableEvents = False
    End With
    
    ' 批量插入空白行
    For i = 1 To insertRows.Count
        ws.Rows(insertRows(i)).Insert Shift:=xlDown
    Next i
    
    ' 恢复Excel原始设置
    With Application
        .ScreenUpdating = True
        .Calculation = xlCalculationAutomatic
        .EnableEvents = True
    End With
    
    ' 释放对象
    Set ws = Nothing
    Set insertRows = Nothing
End Sub

关键优化点说明 #

• 从下往上遍历：避免插入行后下方行号偏移，无需调整遍历索引
• 批量插入：先收集所有需要插入的位置，再一次性执行插入，大幅减少Excel的后台操作次数
• 关闭后台功能：ScreenUpdating关闭界面刷新，Calculation设为手动避免公式重算，EnableEvents关闭事件触发，这些都能显著降低操作耗时
• 使用Long类型：Excel支持的最大行数远超Integer的32767上限，Long可避免溢出错误
• 明确工作表对象：所有单元格操作都指定ws对象，避免因ActiveSheet变化导致的错误

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