使用 VBA 过滤 Excel 并在没有结果时退出 Sub

Question

我有一些代码可以过滤大型数据集，然后选择可见单元格，然后将范围复制并粘贴到其他地方。

Sub Filterstuff()
' Select & Filter data
    Sheets("Main").Select
    Lastrow = ActiveSheet.Range("A2").End(xlDown).Row
    Range("A1").Select
    Range(Selection, Selection.End(xlToRight)).Select
    Range(Selection, Selection.End(xlDown)).Select
    Selection.AutoFilter

' Filter for things
    ActiveSheet.Range("A1:AU" & Lastrow).AutoFilter Field:=39, Criteria1:="words"
    ActiveSheet.Range("A1:AU" & Lastrow).AutoFilter Field:=43, Criteria1:= _
        "<>*wordswords*"

' Find the first unfiltered cell
    Range("A1").Select
    ActiveCell.Offset(1, 0).Select
    Do Until ActiveCell.EntireRow.Hidden = False
        ActiveCell.Offset(1, 0).Select
    Loop

' If there are no unfiltered cells, exit
    If ActiveCell.Row = Lastrow + 1 Then
        Exit Sub

' Else paste results normally
    Else
        Range(Selection, Selection.Offset(0, 47)).Select
        Range(Selection, Selection.End(xlDown)).Select
        Selection.SpecialCells(xlCellTypeVisible).Select
        Selection.Copy
        ' Paste to bottom
        Sheets("PasteSheet").Select
        countrows = Cells(Cells.Rows.Count, "A").End(xlUp).Row
        Range("A" & countrows + 1).Select
        ActiveSheet.Paste
    End If

' Return to Main and unfilter
    Sheets("Main").Select
    Cells.Select
    ActiveSheet.ShowAllData
    Selection.AutoFilter

End Sub

我的问题位于代码块中，如果所有内容都被过滤掉并且过滤后没有包含数据的结果行，则该代码块意味着退出子程序。相关代码从注释部分“查找第一个未过滤的单元格”开始。

此代码查找第一个未隐藏的行，并检查它是否在数据集中的最后一行数据之后。我的问题是它非常慢。我的数据集可以是 100,000+ 行，并且使用 ActiveCell.Offset(1, 0).Select 循环遍历它需要很长时间。

如果所有内容都被过滤掉，我该如何重新编写此代码以退出 sub？

Answer 1

避免使用Select（这将提高运行时性能）：

http://stackoverflow.com/questions/10714251

然后，获取所有“数据”的句柄。最后，应用自动过滤器后，检查范围的SpecialCells(xlCellTypeVisible).Count。

只要.Count 大于您范围内的列数，那么您就有至少一行可见的数据（假设您的数据有headers -- 如果没有 headers，你可以比较是否 > 0)。

未经测试：

Sub Filterstuff()
    ' Select & Filter data
    Dim ws as Worksheet
    Dim rng as Range

    Set ws = Worksheets("Main")
    Set rng = ws.Range("A2:AU" & ws.Range("A2").End(xlDown).Row))

    rng.AutoFilter

    ' Filter for things
    rng.AutoFilter Field:=39, Criteria1:="words"
    rng.AutoFilter Field:=43, Criteria1:="<>*wordswords*"

    ' Find the first unfiltered cell
    If rng.SpecialCells(xlCellTypeVisible).Count > rng.Columns.Count Then
        'Autofilter has returned at least one row of data
    Else
        MsgBox "No data results from Autofilter"
        Exit Sub
    End If

    <more code...>