1

値が空白のすべての行を削除しようとしています。約 15,000 行あり、空白は 25% 以下です。これが私が持っているコードです。

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

コードの 1 行目と 2 行目は正常に機能しますが、3 行目を追加しようとすると、スプレッドシートがタイムアウトし、(応答なし) メッセージが表示されます。私の問題は、コンテンツの量を減らすとコードが機能するため、一度に削除しようとしている行の量だと思います。誰でも修正を提案できますか？なぜエクセルはこれを処理できないのですか？

4

2 に答える 2

3

これに非常に時間がかかる理由は、連続していない範囲が多数あるためです。SpecialCells(xlCellTypeBlanks)

より良い方法は、削除する前にデータをソートすることです。これにより、連続する範囲が 1 つだけ削除されます。

次のように、削除後に元の並べ替え順序を復元できます。

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ミリ秒に短縮されました

于 2013-01-09T20:10:19.760 に答える
0

コードはスプレッドシートのすべての行で実行されています。使用された行で実行する方が高速です。

このようなもの：

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

または、データ範囲を並べ替えるだけで、すべての空白がグループ化されます...

于 2013-01-09T16:43:23.867 に答える