Question

我们有一张工作表，用于分析详细的招标流程，并希望删除任何空行。

每个项目的范围可能不同，最多可能有170列和6000行。

我测试的代码正在使用大约的项目。 40列＆amp; 4750行，只需10分钟即可运行。

寻找任何稍微优雅的解决方案来缩短这段时间。目前，代码将自动过滤每个列的空白，想知道即使是空列被过滤也会减慢整个过程的速度？

在下面的代码中，我删除了大多数autofilter字段以便于查看，但它会过滤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-175中的单元格为空时，添加一个评估为TRUE的列。过滤此列。
要更好地定义需要删除的行，请使用函数定义底行（而不是将底行设置为6000。

e.g：

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自动过滤器＆gt;删除空行

2 个答案: