完整的性能问题 [英] 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屋！