当 VBA 中的自动过滤器不返回数据时该怎么办?
声明:本页面是StackOverFlow热门问题的中英对照翻译,遵循CC BY-SA 4.0协议,如果您需要使用它,必须同样遵循CC BY-SA许可,注明原文地址和作者信息,同时你必须将它归于原作者(不是我):StackOverFlow
原文地址: http://stackoverflow.com/questions/36562549/
Warning: these are provided under cc-by-sa 4.0 license. You are free to use/share it, But you must attribute it to the original authors (not me):
StackOverFlow
What to do when autofilter in VBA returns no data?
提问by lakesh
I am trying to filter a range of values and based on my criteria, at times I might have no data that fits my criteria. In that case, I do not want to copy any data from the filtered data. If there is filtered data, then I would like to copy it.
我正在尝试根据我的标准过滤一系列值,有时我可能没有符合我的标准的数据。在这种情况下,我不想从过滤后的数据中复制任何数据。如果有过滤数据,那么我想复制它。
Here is my code:
这是我的代码:
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 = ""
It is giving me an error at
它给了我一个错误
Set myRange = Workbooks(KGRReport).Worksheets(spreadSheetName).Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible)
When there is no data at all, it is returning an error: "No cells found".
当根本没有数据时,它会返回错误:“未找到单元格”。
Tried error handling like this post: 1004 Error: No cells were found, easy solution?
尝试过像这篇文章这样的错误处理:1004 错误:没有找到单元格,简单的解决方案?
But it was not helping. Need some guidance on how to solve this.
但它没有帮助。需要一些有关如何解决此问题的指导。
回答by brettdj
Try error handling like so:
尝试错误处理,如下所示:
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
回答by Byron Wall
An approach without the error handling
一种没有错误处理的方法
It is possible to build the AutoFilterin a way that does not throw the error if nothing is found. The trick is to include the header row in the call to the SpecialCells. This will ensure that at least 1 row is visible even if nothing is found (Excel will not hide the header row). This prevents the error from jamming up execution and gives you a set of cells to check if data was found.
AutoFilter如果未找到任何内容,则可以以不引发错误的方式构建。诀窍是在调用中包含标题行SpecialCells。这将确保即使未找到任何内容也至少有 1 行可见(Excel 不会隐藏标题行)。这可以防止错误阻塞执行,并为您提供一组单元格来检查是否找到了数据。
To check if the resulting range has data, you need to check Rows.Count > 1 Or Areas.Count > 1. This handles the two possible cases where your data is found directly under the header or in a discontinuous range below the header row. Either result means that the AutoFilterfound valid rows.
要检查结果范围是否有数据,您需要检查Rows.Count > 1 Or Areas.Count > 1. 这可以处理直接在标题下或在标题行下方的不连续范围内找到数据的两种可能情况。任何一个结果都意味着AutoFilter找到了有效的行。
Once you check that data was found, you can then do the desired call to SpecialCellson the data only without concern for an error.
一旦您检查发现数据,您就可以SpecialCells只对数据执行所需的调用,而不必担心出现错误。
Sample data [column C (field 2) will be filtered]:
示例数据 [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
Result with Criteria1:=64
结果与 Criteria1:=64
Immediate window: found data
Immediate window: found data
Result with Criteria1:=0
结果与 Criteria1:=0
Immediate window: only header, no data included
Immediate window: only header, no data included
Other notes:
其他注意事项:
- Code includes a separate variable called
rngDataif you want access to data without headers. This is just an INTERSECT-OFFSET to bump it one row down. - For the case where a result was found, code resets
rngVisibleto be the visible cells in the data only (skips header). Since this call cannot fail now, it is safe without error handling. This gives you a range that matches what you tried the first time but without the chance of getting an erorr. This is not required if you can process the original rangerngVisiblethat includes the headers. If that is true, you can do away withrngDatacompletely (unless you have some other need for it).
rngData如果您想访问没有标头的数据,代码包含一个单独的变量。这只是一个 INTERSECT-OFFSET 将它向下移动一行。- 对于找到结果的情况,代码重置
rngVisible为仅数据中的可见单元格(跳过标题)。由于此调用现在不会失败,因此无需错误处理是安全的。这为您提供了一个与您第一次尝试的范围相匹配的范围,但不会出错。如果您可以处理rngVisible包含标题的原始范围,则这不是必需的。如果这是真的,您可以完全取消rngData(除非您有其他需要)。
回答by user3598756
since you use myRangeas the real output of the filtering action you could go like follows
因为您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
where I also suggested some workbook and worksheet variable settings to "ease" coding life
我还建议了一些工作簿和工作表变量设置以“简化”编码生活
回答by user3598756
Neither of the responses below worked for me. Here is what I finally found that worked:
下面的回答都不适合我。这是我最终发现有效的方法:
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
回答by Jason
You can put the code blow into a function.
你可以把代码吹成一个函数。
Set myRange = Workbooks(KGRReport).Worksheets(spreadSheetName).Range("B2:H" & lastrowinSpreadSheet).SpecialCells(xlVisible)
In the function, use on error goto xxxx. When error return nothing from the function and use "if myRange is not nothing then" to ignore the error cells.
在函数中,在出错时使用 goto xxxx。当错误从函数返回任何内容并使用“if myRange is not nothing then”来忽略错误单元格时。


