作者热门文章
- html - 出于某种原因,IE8 对我的 Sass 文件中继承的 html5 CSS 不友好?
- JMeter 在响应断言中使用 span 标签的问题
- html - 在 :hover and :active? 上具有不同效果的 CSS 动画
- html - 相对于居中的 html 内容固定的 CSS 重复背景?
我必须对表格(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)
意味着您的范围将从您的起始行到工作表的最后一行,而不是数据表的最后一行。作为证明,这里是每个 Range 的行数:
MsgBox ("Rng1 rows : " & rng1.Rows.Count & vbNewLine & _
"Rng2 rows : " & rng2.Rows.Count & vbNewLine & _
"Rng3 rows : " & rng3.Rows.Count)
Range
的列数,可以理解为如此庞大的
Range
分配/取消分配内存和合并/取消合并单元格s 需要一些时间。
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 下面 ,更好的方法是将最后一行保存在变量
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
编辑:
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 VBA 换行会减慢合并任务的执行速度,我们在Stack Overflow上找到一个类似的问题: https://stackoverflow.com/questions/68051859/
我是一名优秀的程序员,十分优秀!