Question

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

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

我的问题位于代码块中，如果所有内容都被过滤掉，并且在过滤后没有包含数据的结果行，则该代码块将退出sub。相关代码从注释部分开始＆＃34;找到第一个未过滤的单元格＆＃34;。

此代码查找第一个未隐藏的行，并检查它是否位于数据集中的最后一行数据之后。我的问题是它非常慢。我的数据集可能超过100,000行，并使用ActiveCell.Offset(1, 0).Select循环遍历它。

如果所有内容都被滤除，我如何重新设置此代码以退出sub？

Answer 1

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

http://stackoverflow.com/questions/10714251

然后，处理所有“数据”。最后，在应用自动过滤后，检查范围SpecialCells(xlCellTypeVisible).Count。

只要.Count 大于您的范围内的列数，那么您至少一行可见数据（假设您的数据有标题 - 如果没有标题，您只需比较是否＆gt; 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...>

如果没有结果，使用VBA过滤Excel并退出Sub

1 个答案: