如何优化在G列变动处插行加小计的VBA代码以提升运行速度？

核心优化点 #

• 关闭屏幕更新、自动重算、事件响应三个拖慢速度的Excel功能，运行完成后再恢复，避免每次操作单元格都刷新界面
• 一次性读取G列全量数据到内存数组中判断，避免逐行读取单元格的性能损耗
• 提前批量定位所有需要插入行的位置，倒序插入避免行号偏移问题，不用逐次循环判断插入
• 所有行插入完成后统一设置公式和格式，减少对象操作次数

优化后完整代码 #

Sub 批量插入分类汇总()
    Dim lastRow As Long, i As Long
    Dim insertRows As Collection
    Dim arrG As Variant
    Dim ws As Worksheet
    Dim originalCalculation As XlCalculation
    
    ' 初始化设置，关闭无关功能提升速度
    Set ws = ActiveSheet ' 可以改成指定工作表，比如Set ws = Sheets("你的表名")
    originalCalculation = Application.Calculation
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Application.Calculation = xlCalculationManual
    
    ' 获取G列最后一行有数据的行号
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row
    ' 把G列第8行到最后一行的数据读入数组
    arrG = ws.Range("G8:G" & lastRow).Value
    
    ' 收集所有需要插入行的位置
    Set insertRows = New Collection
    For i = 1 To UBound(arrG) - 1
        If arrG(i, 1) <> arrG(i + 1, 1) Then
            ' 转换为实际工作表行号，插入位置在当前行的下一行
            insertRows.Add i + 8
        End If
    Next i
    
    ' 倒序插入行，避免行号偏移
    For i = insertRows.Count To 1 Step -1
        ws.Rows(insertRows(i)).Insert
    Next i
    
    ' 重新获取插入行后的最后一行号，批量设置所有汇总行的内容和格式
    lastRow = ws.Cells(ws.Rows.Count, "G").End(xlUp).Row + 1
    For i = 8 To lastRow
        If ws.Range("E" & i).Value = "" And ws.Range("G" & i).Value = "" Then
            ' 定位到汇总行，先找对应的汇总区间
            Dim startRow As Long, endRow As Long
            endRow = i - 1
            startRow = endRow
            Do While startRow > 8 And ws.Range("G" & startRow).Value = ws.Range("G" & startRow - 1).Value
                startRow = startRow - 1
            Loop
            
            ' 设置内容和公式
            ws.Range("E" & i).Value = "Total"
            ws.Range("Q" & i).Formula = "=SUM(Q" & startRow & ":Q" & endRow & ")"
            
            ' 设置格式
            With ws.Range("E" & i & ":X" & i)
                .Locked = True
                .Interior.PatternColorIndex = xlAutomatic
                .Interior.ThemeColor = xlThemeColorDark2
                .Interior.TintAndShade = -0.499984740745262
                .Interior.PatternTintAndShade = 0
                .Font.ThemeColor = xlThemeColorDark1
                .Font.TintAndShade = 0
                .Font.Bold = True
                .HorizontalAlignment = xlCenter
            End With
            
            ' 跳过当前汇总行
            i = i + 1
        End If
    Next i
    
    ' 恢复Excel初始设置
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Application.Calculation = originalCalculation
    
    MsgBox "分类汇总生成完成！", vbInformation
End Sub

注意事项 #

• 运行代码前请先备份工作表数据，避免误操作无法回退
• 如果你的数据不是从第8行开始，可以自行修改代码里行号的起始值
• 如果需要对Q列以外的列也生成汇总，直接仿照Q列公式的写法新增对应列的公式代码即可

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