单元格中的 Excel VBA 换行会减慢合并任务的执行速度
Posted
技术标签:
【中文标题】单元格中的 Excel VBA 换行会减慢合并任务的执行速度【英文标题】：Excel VBA line breaks in cells slow down the execution of a merging task 【发布时间】：2021-09-04 04:14:49 【问题描述】：我必须对表格 (A:W) 进行排序，其中每行合并了一些单元格：(P:Q) 和 (R:T)。执行该任务的代码以某种方式工作，但每次我执行它时 Excel 都会冻结，并且需要大约一分钟才能完成任务。
我测试过，当执行 .Merge Across:=True 时，速度肯定会变慢。我在合并的单元格中有 2 个换行符，似乎格式化是背后的原因。我不知道如何解决，而且我必须坚持这种格式。如果有人可以提供帮助，将不胜感激。
Sub Data_Sort()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Set rng1 = Worksheets("Data").Range("A2:W2", Range("A2:W2").End(xlDown)) 'whole table except the headers
Set rng2 = Worksheets("Data").Range("P2:Q2", Range("P2:Q2").End(xlDown)) 'columns P&Q with merged cells on each row
Set rng3 = Worksheets("Data").Range("R2:T2", Range("R2:T2").End(xlDown)) 'columns R,S,T with merged cells on each row
'===============
'UNMERGE CELLS
'===============
rng1.MergeCells = False 'unmerge all merged cells in the sheet
'===============
'SORT DATA
'===============
With Worksheets("Data").Sort.SortFields 'set up the criteria to sort data alphabetically starting with column A and ending with column G
.Clear
.Add Key:=Range("A2", Range("A2").End(xlDown)), Order:=xlAscending
.Add Key:=Range("B2", Range("B2").End(xlDown)), Order:=xlAscending
.Add Key:=Range("C2", Range("C2").End(xlDown)), Order:=xlAscending
.Add Key:=Range("D2", Range("D2").End(xlDown)), Order:=xlAscending
.Add Key:=Range("E2", Range("E2").End(xlDown)), Order:=xlAscending
.Add Key:=Range("F2", Range("F2").End(xlDown)), Order:=xlAscending
.Add Key:=Range("G2", Range("G2").End(xlDown)), Order:=xlAscending
End With
With Worksheets("Data").Sort 'sort data following to the setups above
.SetRange rng1
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
'===============
'MERGE & FORMAT
'===============
With rng2 'merge and format each row in the range P:Q
.Merge Across:=True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.AddIndent = True
.IndentLevel = 1
End With
With rng3 'merge and format each row in the range R:T
.Merge Across:=True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.AddIndent = True
.IndentLevel = 1
End With
End Sub
【问题讨论】：
您是否尝试在调用With rng2 时放置一个断点（使用F9），然后逐步运行（使用F8）来确定哪一行实际导致了冻结？你有多少行数据？
感谢您的提问。从我之前的测试来看，再一次使用断点，代码执行速度变慢的确切部分是.Merge Across:=True。经过更多测试，现在很明显 Excel 对合并单元格中的原始格式不满意。我在每个单元格中有 2 个换行符，这是再次合并时减慢执行速度的原因。但我需要保持这种格式，所以如果你知道如何在这里加快代码速度？
【参考方案1】：
问题不在于Merge，而在于您声明rng1、rng2 和rng3 的方式。使用.End(xlDown) 意味着您的范围将从您的起始行到工作表的最后一行，而不是到数据表的最后一行。作为证明，这里是每个 Range 的行数：
MsgBox ("Rng1 rows : " & rng1.Rows.Count & vbNewLine & _
"Rng2 rows : " & rng2.Rows.Count & vbNewLine & _
"Rng3 rows : " & rng3.Rows.Count)
将其乘以每个Range 的列数，可以理解为如此庞大的Ranges 分配/取消分配内存以及合并/取消合并单元格需要一些时间。
请试试这个新代码（测试完成后请随时删除MsgBox）：
Sub Data_Sort()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
With ThisWorkbook.Worksheets("Data")
Set rng1 = .Range("A2", "W" & .Cells(.Rows.Count, "W").End(xlUp).Row) 'whole table except the headers
Set rng2 = .Range("P2", "Q" & .Cells(.Rows.Count, "Q").End(xlUp).Row) 'columns P&Q with merged cells on each row
Set rng3 = .Range("R2", "T" & .Cells(.Rows.Count, "T").End(xlUp).Row) 'columns R,S,T with merged cells on each row
MsgBox ("Rng1 rows : " & rng1.Rows.Count & vbNewLine & _
"Rng2 rows : " & rng2.Rows.Count & vbNewLine & _
"Rng3 rows : " & rng3.Rows.Count)
'===============
'UNMERGE CELLS
'===============
rng1.MergeCells = False 'unmerge all merged cells in the sheet
'===============
'SORT DATA
'===============
With .Sort.SortFields 'set up the criteria to sort data alphabetically starting with column A and ending with column G
.Clear
.Add Key:=Range("A2", "A" & .Cells(.Rows.Count, "A").End(xlUp).Row), Order:=xlAscending
.Add Key:=Range("B2", "B" & .Cells(.Rows.Count, "B").End(xlUp).Row), Order:=xlAscending
.Add Key:=Range("C2", "C" & .Cells(.Rows.Count, "C").End(xlUp).Row), Order:=xlAscending
.Add Key:=Range("D2", "D" & .Cells(.Rows.Count, "D").End(xlUp).Row), Order:=xlAscending
.Add Key:=Range("E2", "E" & .Cells(.Rows.Count, "E").End(xlUp).Row), Order:=xlAscending
.Add Key:=Range("F2", "F" & .Cells(.Rows.Count, "F").End(xlUp).Row), Order:=xlAscending
.Add Key:=Range("G2", "G" & .Cells(.Rows.Count, "G").End(xlUp).Row), Order:=xlAscending
End With
With .Sort 'sort data following to the setups above
.SetRange rng1
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
'===============
'MERGE & FORMAT
'===============
With rng2 'merge and format each row in the range P:Q
.Merge Across:=True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.AddIndent = True
.IndentLevel = 1
End With
With rng3 'merge and format each row in the range R:T
.Merge Across:=True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.AddIndent = True
.IndentLevel = 1
End With
End With
End Sub
如果您有一个平方数据表（每一列都在同一行结束）表格下方没有写任何内容，更好的方法是将最后一行保存在变量 lLastRow 和每次需要时调用它：
Sub Data_Sort_With_UsedRange()
Dim rng1 As Range
Dim rng2 As Range
Dim rng3 As Range
Dim lLastRow As Long
With ThisWorkbook.Worksheets("Data")
lLastRow = .UsedRange.Rows(.UsedRange.Rows.Count).Row
Set rng1 = .Range("A2", "W" & lLastRow) 'whole table except the headers
Set rng2 = .Range("P2", "Q" & lLastRow) 'columns P&Q with merged cells on each row
Set rng3 = .Range("R2", "T" & lLastRow) 'columns R,S,T with merged cells on each row
MsgBox ("Rng1 rows : " & rng1.Rows.Count & vbNewLine & _
"Rng2 rows : " & rng2.Rows.Count & vbNewLine & _
"Rng3 rows : " & rng3.Rows.Count)
'===============
'UNMERGE CELLS
'===============
rng1.MergeCells = False 'unmerge all merged cells in the sheet
'===============
'SORT DATA
'===============
With .Sort.SortFields 'set up the criteria to sort data alphabetically starting with column A and ending with column G
.Clear
.Add Key:=Range("A2", "A" & lLastRow), Order:=xlAscending
.Add Key:=Range("B2", "B" & lLastRow), Order:=xlAscending
.Add Key:=Range("C2", "C" & lLastRow), Order:=xlAscending
.Add Key:=Range("D2", "D" & lLastRow), Order:=xlAscending
.Add Key:=Range("E2", "E" & lLastRow), Order:=xlAscending
.Add Key:=Range("F2", "F" & lLastRow), Order:=xlAscending
.Add Key:=Range("G2", "G" & lLastRow), Order:=xlAscending
End With
With .Sort 'sort data following to the setups above
.SetRange rng1
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.Apply
End With
'===============
'MERGE & FORMAT
'===============
With rng2 'merge and format each row in the range P:Q
.Merge Across:=True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.AddIndent = True
.IndentLevel = 1
End With
With rng3 'merge and format each row in the range R:T
.Merge Across:=True
.HorizontalAlignment = xlLeft
.VerticalAlignment = xlCenter
.AddIndent = True
.IndentLevel = 1
End With
End With
End Sub
编辑：
似乎范围声明只是问题的一部分。其余的滞后是由于工作表的视觉和计算更新。有关上下文，请查看此Guide to efficient VBA code。
要修复它，请尝试在调用 With ThisWorkbook.Worksheets("Data") 之前添加此代码：
With Application
.ScreenUpdating = False
.StatusBar = False
.Calculation = xlCalculationManual
.EnableEvents = False
.DisplayAlerts = False
.PrintCommunication = False
End With
还有End With之后的这个：
With Application
.ScreenUpdating = True
.StatusBar = True
.Calculation = xlCalculationAutomatic
.EnableEvents = True
.DisplayAlerts = True
.PrintCommunication = True
End With
您可以使用Timer function 查看执行持续时间，在代码前使用startTimer，在代码后使用endTimer。总时长显示为MsgBox "Duration = " & endTimer - startTimer & "s"。
【讨论】：
非常感谢。事实上，不通过整张纸更有效。我将代码应用于方桌，它可以工作。从现在开始，我将使用您的代码。仍然在此期间，我发现合并单元格的格式是减速的主要原因。我在这些单元格中有换行符，据我所知，由于这些原因，Excel 执行合并命令需要时间。我用你的修复测试了，不幸的是问题仍然存在。 在 Excel 中合并单元格是一个众所周知的非高效过程。也许尝试遍历rng2 和rng3 的行并使用.MergeCells = True 而不是Merge Across:=True。我对结果很确定，但值得测试。另一种选择是使用.HorizontalAlignment = xlHAlignCenterAcrossSelection，它只视觉上合并单元格并且比Merge属性更快，但你会失去左对齐。
@D.Fox 我做了一些测试，我认为你的滞后是由于你的 Excel 工作表的视觉更新。测试 500 行随机数据：启用更新大约 30 秒，禁用更新大约 0.08 秒。请参阅我的答案的编辑。
@Vincent 你的编辑很有魅力，非常感谢。执行整个代码仅需 2 秒。我从来没有想过以这种方式处理这个问题。除了定时器功能是一个很好的技巧，我会重复使用它。最后感谢我开始学习的高效编码指南。
@D.Fox 不客气！ :) 本指南帮助我加快代码速度，希望对您有所帮助。以上是关于单元格中的 Excel VBA 换行会减慢合并任务的执行速度的主要内容，如果未能解决你的问题，请参考以下文章
使用OLEDB读取EXCEL数据时，为何读取不到单元格中的时间值，全是1900\1\0