VBA代码基于单元格值添加空行卡顿崩溃，求优化方案

问题描述 #

我写了一段VBA代码，第一部分用于添加一行空行（此处已出现卡顿），第二部分通过i循环根据指定单元格的值批量添加空行。这段代码运行时卡顿严重，耗时2-3分钟甚至直接崩溃。奇怪的是，代码在两个子过程分支里，分支1运行正常，另一个分支却卡顿崩溃。我确认代码逻辑本身可用，但搞不懂差异原因，现寻求优化方案解决卡顿崩溃问题。

原代码 #

Application.CutCopyMode = False
Application.ScreenUpdating = False
Sheets("worksheet1").Select

Range("F2").Select
Selection.Insert 
Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove  

Supply = Range("AO189") 
Dim i As Integer
Dim numdx As Integer
numdx = Range("t219") + 4 

Range("F1").Select
ActiveCell.Offset(Tier + 7).Select 
For i = 1 To numdx
Selection.Insert 
Shift:=xlDown,    
CopyOrigin:=xlFormatFromLeftOrAbove
Next i

卡顿核心原因 #

1. 频繁使用Select/Selection：这是VBA性能的头号杀手，每次选择单元格都会触发Excel底层的界面交互逻辑，哪怕关闭了屏幕更新，仍会产生大量不必要的开销。
2. 循环逐行插入：如果numdx数值较大（比如上千），循环执行数千次插入操作，每次插入都会让Excel重新调整行位置、刷新格式，累积开销直接拖垮性能。
3. 未关闭额外后台操作：仅关闭屏幕更新不够，Excel默认的自动计算、工作表事件会在插入行时后台运行，进一步加剧卡顿。

优化后的代码 #

Application.CutCopyMode = False
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual ' 关闭自动计算
Application.EnableEvents = False ' 禁用工作表事件

Dim ws As Worksheet
Set ws = ThisWorkbook.Sheets("worksheet1")

' 直接插入单行，无需Select
ws.Range("F2").Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

Dim numdx As Integer
numdx = ws.Range("T219").Value + 4
Dim insertStartRow As Integer
insertStartRow = ws.Range("F1").Row + Tier + 7 ' 直接计算起始行位置

' 一次性插入多行，替代循环逐行操作
ws.Rows(insertStartRow & ":" & insertStartRow + numdx - 1).Insert Shift:=xlDown, CopyOrigin:=xlFormatFromLeftOrAbove

' 恢复Excel默认设置
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
Application.ScreenUpdating = True

优化点说明 #

• 彻底移除Select/Selection：直接操作Range和Worksheet对象，避免不必要的对象交互开销。
• 批量插入多行：把循环逐行插入改成一次性插入numdx行，大幅减少Excel的行调整、格式刷新次数，性能提升显著。
• 关闭自动计算与事件：插入行时暂时关闭自动计算和工作表事件，避免后台额外计算拖慢速度。
• 明确对象引用：用ws变量指定目标工作表，避免ActiveSheet的不确定性，代码逻辑更清晰。

分支差异原因推测 #

两个分支的运行差异大概率是因为：

• 分支1中numdx数值很小，循环次数少，卡顿不明显；另一分支numdx数值大，循环次数多，累积开销直接导致崩溃。
• 分支1所在工作表数据量小、公式少，插入行时的后台计算压力低；另一分支工作表数据量大、公式复杂，逐行插入时的计算开销远超系统承载能力。

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