VBA中的自动过滤器没有返回数据怎么办？

Question

我正在尝试根据我的标准过滤一系列值，有时我可能没有符合我标准的数据。在这种情况下，我不想从过滤后的数据中复制任何数据。如果有过滤数据，我想复制它。

这是我的代码：

With Workbooks(KGRReport).Worksheets(spreadSheetName).Range("A1:I" & lastrowinSpreadSheet)
    .AutoFilter Field:=3, Criteria1:=LimitCriteria, Operator:=xlFilterValues 'Do the filtering for Limit
     .AutoFilter Field:=9, Criteria1:=UtilizationCriteria, Operator:=xlFilterValues 'Do the filtering for Bank/NonBank
End With

'Clear the template
 Workbooks(mainwb).Worksheets("Template").Activate
 Workbooks(mainwb).Worksheets("Template").Rows(7 & ":" & Rows.Count).Delete

 'Copy the filtered data
 Workbooks(KGRReport).Activate
 Set myRange = Workbooks(KGRReport).Worksheets(spreadSheetName).Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible)
 For Each myArea In myRange.Areas
     For Each rw In myArea.Rows
           strFltrdRng = strFltrdRng & rw.Address & ","
     Next
 Next

 strFltrdRng = Left(strFltrdRng, Len(strFltrdRng) - 1)
 Set myFltrdRange = Range(strFltrdRng)
 myFltrdRange.Copy
 strFltrdRng = ""

它给了我一个错误

Set myRange = Workbooks(KGRReport).Worksheets(spreadSheetName).Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible)

当根本没有数据时，它会返回错误：“未找到单元格”。

尝试过像这篇文章这样的错误处理：1004 Error: No cells were found, easy solution?

但这没有帮助。需要一些有关如何解决此问题的指导。

Answer 1

尝试像这样处理错误：

Dim myRange As Range

On Error Resume Next
Set myRange = Range("your range here").SpecialCells(xlVisible)
On Error GoTo 0

If myRange Is Nothing Then
    MsgBox "no cells"
Else
    'do stuff
End If

Answer 2

没有错误处理的方法

如果没有找到任何内容，则可以以一种不会引发错误的方式构建AutoFilter。诀窍是在对SpecialCells 的调用中包含标题行。这将确保即使没有找到至少 1 行可见（Excel 不会隐藏标题行）。这可以防止错误阻碍执行，并为您提供一组单元格来检查是否找到数据。

要检查结果范围是否有数据，您需要检查Rows.Count > 1 Or Areas.Count > 1。这可以处理两种可能的情况，即您的数据直接位于标题下方或位于标题行下方的不连续范围内。任一结果都意味着AutoFilter 找到了有效行。

一旦您检查是否找到了数据，您就可以只对数据进行所需的SpecialCells 调用，而无需担心出现错误。

样本数据[将过滤 C 列（字段 2）]：

Sub TestAutoFilter()

    'this is your block of data with headers
    Dim rngDataAndHeader As Range
    Set rngDataAndHeader = Range("B2").CurrentRegion

    'this will knock off the header row if you want data only
    Dim rngData As Range
    Set rngData = Intersect(rngDataAndHeader, rngDataAndHeader.Offset(1))

    'autofilter
    rngDataAndHeader.AutoFilter Field:=2, Criteria1:=64

    'get the visible cells INCLUDING the header row
    Dim rngVisible As Range
    Set rngVisible = rngDataAndHeader.SpecialCells(xlCellTypeVisible)

    'check if there are more than 1 rows or if there are multiple areas (discontinuous range)
    If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
        Debug.Print "found data"

        'data is available, this call cannot throw an error now
        Set rngVisible = rngData.SpecialCells(xlCellTypeVisible)

        'do your normal execution here
        '
        '
        '
    Else
        Debug.Print "only header, no data included"
    End If
End Sub

Criteria1:=64 的结果

Immediate window: found data

Criteria1:=0 的结果

Immediate window: only header, no data included

其他说明：

• 如果您想访问没有标题的数据，代码包含一个名为rngData 的单独变量。这只是一个 INTERSECT-OFFSET，可以将其向下移动一排。
• 对于找到结果的情况，代码将rngVisible 重置为仅数据中的可见单元格（跳过标题）。由于这个调用现在不能失败，所以没有错误处理是安全的。这为您提供了一个与您第一次尝试的范围相匹配但不会出错的范围。如果您可以处理包含标头的原始范围rngVisible，则不需要这样做。如果这是真的，您可以完全取消 rngData（除非您有其他需要）。

Answer 3

由于您使用 myRange 作为过滤操作的实际输出，因此您可以如下所示

Dim wbKGRR As Workbook  '<== better set variable for workbooks you'll work with: it saves both typing time and possible errors
Dim ws As Worksheet  '<== better set variable for worksheets you'll work with: it saves both typing time and possible errors

'...


Set wbKGRR = Workbooks(KGRReport) '<== better set variable for workbooks: it saves both typing time and possible errors
Set ws = wbKGRR.Worksheets(spreadSheetName)  '<== better set variable for worksheets you'll work with: it saves both typing time and possible errors

With ws
    With .Range("A1:I" & lastrowinSpreadSheet)
        .AutoFilter Field:=3, Criteria1:=LimitCriteria, Operator:=xlFilterValues 'Do the filtering for Limit
        .AutoFilter Field:=9, Criteria1:=UtilizationCriteria, Operator:=xlFilterValues 'Do the filtering for Bank/NonBank
    End With
    If Application.WorksheetFunction.Subtotal(103, .Columns("B")) > 0 Then Set myRange = .Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible) '<== myRange will be set only if filtering has left some visible cells
End With


'Clear the template
'Workbooks(mainwb).Worksheets("Template").Activate '<== no need to activate
Workbooks(mainwb).Worksheets("Template").Rows(7 & ":" & Rows.Count).Delete

'Copy the filtered data
' Workbooks(KGRReport).Activate '<== no need to activate
If Not myRange Is Nothing Then '<== "myRange" has been set properly if previous Autofilter method has left some visbile cells
    For Each myArea In myRange.Areas
        For Each rw In myArea.Rows
              strFltrdRng = strFltrdRng & rw.Address & ","
        Next rw
    Next myArea

    strFltrdRng = Left(strFltrdRng, Len(strFltrdRng) - 1)
    Set myFltrdRange = Range(strFltrdRng)
    myFltrdRange.Copy
    strFltrdRng = ""
End If

我还建议了一些工作簿和工作表变量设置以“简化”编码生活

Answer 4

你可以把代码吹成一个函数。

Set myRange = Workbooks(KGRReport).Worksheets(spreadSheetName).Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible)

在函数中，错误时使用 goto xxxx。 当错误从函数中不返回任何内容并使用“如果 myRange 不是什么都没有”时忽略错误单元格。

Answer 5

以下回答均不适合我。这是我最终发现有效的方法：

Sub fileterissues()

Dim VisibleRows as Long

‘Some code here

With Sheets(ws1).Range(“myrange”)
.Autofilter Field:=myfieldcolumn, criteria:=myfiltercriteria
VisibleRows = Application.Worksheetfunction.Subtotal(103, sheets(1).mycolumnfieldrange)
If VisibleRows = 0 then Resume Next
End with

‘More code

End sub