Excel VBA自動篩選>刪除空行

Question

我們有一張表用於分析詳細的招標過程，並希望刪除任何空行。

范圍可能因項目而異，最多可能有170列和6000行。

我測試的代碼正在使用大約的項目。 40列和4750行，運行時間僅為10分鍾。

尋找任何稍微優雅的解決方案來縮短這一時間。 目前代碼將自動過濾每個列的空白，想知道即使是空列被過濾也會減慢整個過程的速度？

在下面的代碼中，我刪除了大多數自動過濾器字段以便於查看，但它會過濾1-175中的每個字段。

Sub DeleteEmptyRows()

With Sheets("Detailed Comparison")
    Application.DisplayAlerts = False
    .AutoFilterMode = False
    Application.ScreenUpdating = False

    With .Range("F24:FY6000")
        .AutoFilter
        .AutoFilter Field:=1, Criteria1:="="
        .AutoFilter Field:=2, Criteria1:="="
        .AutoFilter Field:=175, Criteria1:="="
    End With

    With .Range("F25:FY6000").SpecialCells(xlCellTypeVisible).Rows.Delete
    End With

    Application.DisplayAlerts = True

    .AutoFilterMode = False
    Application.ScreenUpdating = True
End With

End Sub

Answer 1

您可以添加一個額外的列，其中包含該行的所有無空字段的計數 - 例如= COUNTA（F24：FY24） - 然后過濾此列中值為0的行。

我沒有測試過這個，但是猜測它應該更快......

Answer 2

使事情更優雅

1. 當列1-175中的單元格為空時，添加一個計算結果為TRUE列。 過濾此列。

2. 要更好地定義需要刪除的行，請使用函數定義底行（而不是將底行設置為6000。

例如：

Function LastRowInOneColumn(ws As Worksheet, Optional bool As Boolean) As Long

'Find the last used row in a Column
'by default, returns row of column A (FLASE)
'if bool is TRUE then will return row of column B

Dim LastRow As Long
Dim col As String

If bool = True Then
    col = "B"
Else
    col = "A"
End If

With ws
    LastRow = .Cells(.Rows.Count, col).End(xlUp).row
End With

LastRowInOneColumn = LastRow

End Function

速度

我建議您測試以查看代碼的哪些部分運行得如此之慢。 如果是過濾，則建議1（上述）應該有所幫助。 如果刪除的可能是工作簿的其他部分鏈接到此數據集，因此刪除數據將非常慢。 如果是這種情況，我的建議是更改您的其他數據集，以便它們通過您刪除的命名范圍引用此工作表作為DeleteEmptyRows宏的第一步，然后在運行結束時重新創建這些命名范圍宏

Sub set_named_ranges()

'creates named ranges needed for this workbook
'this code is somewhat crude, you may need to modify based on how your data are laid out

Dim found As Range
Dim col_lookup_text As String
dim wks_name As String

wks_name = "Detailed Comparison"

Worksheets(wks_name).Select
Worksheets(wks_name).Range("A1").Select
Range(Selection, Selection.End(xlToRight)).Select

'header named range
ActiveWorkbook.Names.Add _
        Name:=("data_Header"), _
        RefersTo:=Range(wks_name & "!" & RngAddress(Selection))

'main data named range
Range(Selection, Selection.End(xlDown)).Select

ActiveWorkbook.Names.Add _
        Name:=("dataset"), _
        RefersTo:=Range(wks_name & "!" & RngAddress(Selection))

End Sub

Function RngAddress(rng As Range) As String
RngAddress = rng.Address
End Function

和：

Sub delete_these_named_ranges(ParamArray names_of_named_ranges() As Variant)

'not a very sexy macro
'feed macro names of named ranges
'deletes the named range
'if named range doesn't exist, it creates a named range with
'that name and deletes it to avoid errors

Dim nName As Variant

For Each nName In names_of_named_ranges

    On Error Resume Next
    ActiveWorkbook.Names.Add Name:=nName, RefersTo:="temp"
    ActiveWorkbook.Names(nName).Delete

Next nName

End Sub