完整的性能问题 [英] EntireRow.Delete performance issue
问题描述
我正在尝试删除所有具有空白值的行。我有大约15,000行,不超过25%是空白的。这是我的代码。
I am trying to delete all rows with blanks values. I have about 15,000 rows and no more than 25% are blank. Here is the code I have.
Columns("A:A").Select
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete
第一行和第二行代码工作正常然而,当我尝试添加第三行时,我的电子表格超时,我留下了一个(不响应)消息。我认为我的问题是我正在尝试删除的行数,因为当我减少内容的数量时,代码可以工作。有人可以建议修复吗?为什么不能处理这个?
The first and second lines of code work fine however, when I try to add the third line my spreadsheet times out and I am left with a (Not Responding) message. I think my issue is the amount of rows I am trying to delete at once because the code works when I reduce the amount of content. Can anyone suggest a fix? Why can't excel handle this?
推荐答案
这个需要很长时间的原因是大量的不连续范围在 SpecialCells(xlCellTypeBlanks)
The reason this takes so long is the large number of discontinuous ranges in SpecialCells(xlCellTypeBlanks)
更好的方法是在删除之前排序数据,所以只有一个连续范围被删除
A better way is to sort the data before the delete, so only one continuous range is deleted
然后,您可以在删除后恢复原始排序顺序,如下所示:
You can then restore the original sort order after the delete, something like this:
Sub Demo()
Dim rng As Range
Dim rSortCol As Range
Dim rDataCol As Range
Dim i As Long
Dim BlockSize As Long
Dim sh As Worksheet
Dim TempCol As Long
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Application.EnableEvents = False
Set sh = ActiveSheet
Set rng = sh.UsedRange
With rng
' Add a temporary column to hold a index to restore original sort
TempCol = .Column + .Columns.Count
Set rSortCol = .Columns(TempCol)
rSortCol.Cells(1, 1) = 1
rSortCol.Cells(1, 1).AutoFill rSortCol, xlFillSeries
Set rng = rng.Resize(, rng.Columns.Count + 1)
Set rDataCol = rng.Columns(1)
' sort on data column, so blanks get grouped together
With sh.Sort
.SortFields.Clear
.SortFields.Add Key:=rDataCol, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
' delete blanks (allow for possibility there are no blanks)
On Error Resume Next
Set rng = rDataCol.SpecialCells(xlCellTypeBlanks)
If Err.Number <> 0 Then
' no blank cells
Err.Clear
Else
rng.EntireRow.Delete
End If
On Error GoTo 0
' Restore original sort order
With sh.Sort
.SortFields.Clear
.SortFields.Add Key:=rSortCol, _
SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
.SetRange rng
.Header = xlNo
.MatchCase = False
.Orientation = xlTopToBottom
.SortMethod = xlPinYin
.Apply
End With
End With
' Delete temp column
sh.Columns(TempCol).EntireColumn.Delete
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Application.EnableEvents = True
End Sub
我的测试(在〜15000行,ev第4行空白)将时间从〜20s缩短到〜150ms
My testing (on ~15000 rows, every 4th row blank) reduced time from ~20s to ~150ms
这篇关于完整的性能问题的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!