Excel VBA 自动筛选 > 删除空行

Question

我们有一个 sheet 用于分析详细的招标过程，并希望删除任何空行。

每个项目的范围可能不同，最多可能有 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

您可以添加一个附加列，其中包含该行所有 none 个空字段的计数 - 例如=COUNTA(F24:FY24) - 然后过滤此列中值 = 0 的行。

我还没有测试过这个，但我猜它应该快得多...

Answer 2

让事情更优雅

添加一个列，当第 1-175 列中的单元格为空白时，该列的计算结果为 TRUE。过滤此列。
为了更好地定义需要删除的行，请使用函数定义底行（而不是将底行设置为 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

Excel VBA 自动筛选 > 删除空行

Excel VBA Autofilter > Delete Empty Rows

excel

vba

rows

autofilter