Question

我正在尝试删除所有具有空白值的行。我有大约15,000行，不超过25％是空白。这是我的代码。

Columns("A:A").Select 
Selection.SpecialCells(xlCellTypeBlanks).Select
Selection.EntireRow.Delete

第一行代码和第二行代码工作正常但是，当我尝试添加第三行时，我的电子表格超时，我留下了一条（无响应）消息。我认为我的问题是我一次尝试删除的行数，因为代码在减少内容量时起作用。有人可以建议修复吗？为什么excel不能处理这个？

Answer 1

这需要很长时间的原因是SpecialCells(xlCellTypeBlanks)

中的大量不连续范围

更好的方法是在删除之前对数据进行排序，因此只删除一个连续范围

然后，您可以在删除后恢复原始排序顺序，如下所示：

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行，每隔4行空白）将时间从大约20秒减少到大约150毫秒

Answer 2

您的代码正在电子表格中的所有行上运行;在使用过的行上运行它会更快。

这样的事情：

Range("A1", Cells(Sheet1.Rows.Count, 1).End(xlUp).Address).SpecialCells(xlCellTypeBlanks).EntireRow.Delete

或者，您可以对数据范围进行排序 - 将所有空白组合在一起......

EntireRow.Delete性能问题

2 个答案: