如何在Excel/VBA中高效将自动适配行高转为固定行高？

问题场景 #

需要处理大量含不同数量合并单元格的行高：

1. 将目标区域复制到数组后粘贴至右侧，取消单元格合并
2. 对取消合并后的区域设置自动适配行高
3. 遍历每行执行Rows(i).RowHeight = Rows(i).RowHeight固定行高，随后清除粘贴的数据以保留固定行高
   当前代码运行耗时10-15秒，调整基础应用设置（如关闭屏幕更新、手动计算等）无明显改善，需更高效的批量处理方案。

原代码 #

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim i As Long
For i = 1 To 1000
    Rows(i).RowHeight = Rows(i).RowHeight
Next

优化方案 #

逐行循环是性能瓶颈，核心优化方向是减少VBA与Excel对象模型的交互次数（这是VBA操作Excel的主要耗时点），通过批量操作替代逐行遍历。

优化代码示例

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim targetRows As Range
Set targetRows = Rows("1:1000") ' 可根据实际需求调整行范围

' 直接批量固定行高，无需逐行循环
targetRows.RowHeight = targetRows.RowHeight

' 恢复应用默认设置
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

进阶优化（针对复杂场景）

如果自动行高的适配范围仅为局部区域，可先批量读取行高到内存数组，再批量赋值，进一步降低交互开销：

Application.ScreenUpdating = False
Application.EnableEvents = False
Application.DisplayAlerts = False
Application.Calculation = xlCalculationManual

Dim targetRows As Range
Dim rowHeights() As Double
Dim i As Long

Set targetRows = Rows("1:1000")
ReDim rowHeights(1 To targetRows.Count)

' 一次性读取所有行高到内存数组
For i = 1 To targetRows.Count
    rowHeights(i) = targetRows(i).RowHeight
Next

' 批量赋值固定行高
For i = 1 To targetRows.Count
    targetRows(i).RowHeight = rowHeights(i)
Next

' 恢复应用默认设置
Application.ScreenUpdating = True
Application.EnableEvents = True
Application.DisplayAlerts = True
Application.Calculation = xlCalculationAutomatic

优化逻辑说明 #

• 直接对整行范围执行RowHeight = RowHeight，本质是一次性完成所有行的行高读取与赋值，仅触发两次对象交互，替代原代码的1000次逐行调用
• 内存数组存储行高的方式，把多次Excel对象读取转为内存操作，进一步减少耗时（适合行范围极大的场景）
• 取消合并后，自动适配的行高已计算完成，批量赋值即可直接固定，无需额外操作

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