Excel VBA 单元格中的换行符会减慢合并任务的执行速度
Excel VBA line breaks in cells slow down the execution of a merging task
我必须对 table (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
问题不是来自 Merge
,而是来自您声明 rng1
、rng2
和 rng3
的方式。使用 .End(xlDown)
意味着您的范围将从您的起始行到 sheet 的 最后一行,而不是您的 最后一行数据table。作为证明,这是每个范围的行数:
MsgBox ("Rng1 rows : " & rng1.Rows.Count & vbNewLine & _
"Rng2 rows : " & rng2.Rows.Count & vbNewLine & _
"Rng3 rows : " & rng3.Rows.Count)
将其乘以每个 Range
的列数,可以理解 allocation/desallocation 内存和 merging/unmerging 单元用于如此大的 Range
需要一些时间.
请尝试这个新代码(测试完成后,请随意删除 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
如果你有一个平方数据 table(每列在同一行结束)并且 table 下方没有任何内容,更好的方法是将最后一行保存在变量 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
编辑:
范围声明似乎只是问题的一部分。其余的滞后是由于工作的视觉和计算更新sheet。对于上下文,请查看此 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"
。
我必须对 table (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
问题不是来自 Merge
,而是来自您声明 rng1
、rng2
和 rng3
的方式。使用 .End(xlDown)
意味着您的范围将从您的起始行到 sheet 的 最后一行,而不是您的 最后一行数据table。作为证明,这是每个范围的行数:
MsgBox ("Rng1 rows : " & rng1.Rows.Count & vbNewLine & _
"Rng2 rows : " & rng2.Rows.Count & vbNewLine & _
"Rng3 rows : " & rng3.Rows.Count)
将其乘以每个 Range
的列数,可以理解 allocation/desallocation 内存和 merging/unmerging 单元用于如此大的 Range
需要一些时间.
请尝试这个新代码(测试完成后,请随意删除 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
如果你有一个平方数据 table(每列在同一行结束)并且 table 下方没有任何内容,更好的方法是将最后一行保存在变量 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
编辑:
范围声明似乎只是问题的一部分。其余的滞后是由于工作的视觉和计算更新sheet。对于上下文,请查看此 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"
。