Excel VBA 用于检查数据的自动过滤器
声明：本页面是StackOverFlow热门问题的中英对照翻译，遵循CC BY-SA 4.0协议，如果您需要使用它，必须同样遵循CC BY-SA许可，注明原文地址和作者信息，同时你必须将它归于原作者（不是我）：StackOverFlow
原文地址: http://stackoverflow.com/questions/12681474/
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
Excel VBA to check autofilter for data
提问by cav719
I need help checking for autofiltered rows not including the header. I want it to give a message box "No records found." then exit sub or continue with copy paste if there are rows beyond the header row. I know I need an If/Else entry after the filter to check for data but I'm having trouble figuring how to check. This code is being done from a UserForm button I created.
我需要帮助检查不包括标题的自动过滤行。我希望它给出一个消息框“未找到记录”。如果标题行之外还有行，则退出子程序或继续复制粘贴。我知道在过滤器之后我需要一个 If/Else 条目来检查数据，但我无法确定如何检查。这段代码是通过我创建的用户窗体按钮完成的。
Here is my script:
这是我的脚本：
Private Sub Searchbycompanyfield_Click()
If CompanyComboBox1.Value = "" Then
MsgBox "Please enter a Company to begin search."
Exit Sub
End If
ActiveSheet.Range("$A:$H").AutoFilter Field:=1, Criteria1:=EQDataEntry.CompanyComboBox1.Value, Operator:=xlOr
Cells.Select
Selection.Copy
Sheets("Sheet2").Select
Range("A5").Select
ActiveSheet.Paste
Call MessageBoxYesOrNoMsgBox
End Sub
Any help would be greatly appreciated.
任何帮助将不胜感激。
回答by nutsch
count the lines, or check if the last row is the header
计算行数，或检查最后一行是否是标题
if application.worksheetfunction.subtotal(3,activesheet.columns(1))>1 then
msgbox "Records"
else
msgbox "No Records"
end if
check the last row
检查最后一行
if activesheet.cells(rows.count,1).end(xlup).row>1 then
msgbox "Records"
else
msgbox "No Records"
end if
回答by InContext
See below, SpecialCells(xlCellTypeVisible) will allow you to return a rng object of the filtered cells. You just need to check the number of rows in this for your condition:
见下文，SpecialCells(xlCellTypeVisible) 将允许您返回过滤单元格的 rng 对象。您只需要根据您的情况检查其中的行数：
Private Sub Searchbycompanyfield_Click()
If CompanyComboBox1.Value = "" Then
MsgBox "Please enter a Company to begin search."
Exit Sub
End If
Dim sh As Worksheet
Dim rng As Range
Set sh = ActiveSheet
sh.AutoFilterMode = False
sh.Range("$A:$H").AutoFilter Field:=1, Criteria1:=EQDataEntry.CompanyComboBox1.Value, Operator:=xlOr
Set rng = sh.UsedRange.SpecialCells(xlCellTypeVisible)
If (rng.Rows.Count > 1) Then
rng.Copy Sheets("Sheet2").[A5]
Call MessageBoxYesOrNoMsgBox
End If
End Sub
回答by cav719
For anyone else needing this, I ended up using:
对于其他需要这个的人，我最终使用了：
Private Sub Searchbycompanyfield_Click()
Private Sub Searchbycompanyfield_Click()
If CompanyComboBox1.Value = "" Then
MsgBox "Please enter a Company to begin search."
Exit Sub
End If
Dim sh As Worksheet
Dim rng As Range
Set sh = ActiveSheet
sh.AutoFilterMode = False
sh.Range("$A:$H").AutoFilter Field:=1, Criteria1:=EQDataEntry.CompanyComboBox1.Value, Operator:=xlOr
Set rng = sh.UsedRange.SpecialCells(xlCellTypeVisible)
If (rng.Rows.Count > 1) Then
rng.Copy Sheets("Sheet2").[A5]
Sheets("Sheet2").Select
Call MessageBoxYesOrNoMsgBox
Else
If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
MsgBox "No records found."
Exit Sub
End If
If CompanyComboBox1.Value = "" Then
MsgBox "Please enter a Company to begin search."
Exit Sub
End If
Dim sh As Worksheet
Dim rng As Range
Set sh = ActiveSheet
sh.AutoFilterMode = False
sh.Range("$A:$H").AutoFilter Field:=1, Criteria1:=EQDataEntry.CompanyComboBox1.Value, Operator:=xlOr
Set rng = sh.UsedRange.SpecialCells(xlCellTypeVisible)
If (rng.Rows.Count > 1) Then
rng.Copy Sheets("Sheet2").[A5]
Sheets("Sheet2").Select
Call MessageBoxYesOrNoMsgBox
Else
If ActiveSheet.AutoFilterMode Then ActiveSheet.Cells.AutoFilter
MsgBox "No records found."
Exit Sub
End If
End Sub
End Sub
Thanks again for your helps guys.
再次感谢您的帮助。
回答by Vasanth8891
I found a solution for this. Try this solution.
我为此找到了解决方案。试试这个解决方案。
Dim count As Long
count = Application.WorksheetFunction.count(rng_SmPrt.SpecialCells(xlCellTypeVisible))
This one returns the no of visible rows correctly.
这个正确返回可见行数。
回答by chris neilsen
Here's your maco refactored to demo a method of using the filter range. Also removes the need to Selectranges
这是重构的 maco 以演示使用过滤器范围的方法。还消除了Select范围的需要
Sub Searchbycompanyfield()
If CompanyComboBox1.Value = "" Then
MsgBox "Please enter a Company to begin search."
Exit Sub
End If
Dim sh As Worksheet
Dim rng As Range
Set sh = ActiveSheet
' clear any existing autofilter
sh.AutoFilterMode = False
sh.Range("$A:$H").AutoFilter Field:=1, _
Criteria1:=EQDataEntry.CompanyComboBox1.Value, Operator:=xlOr
Set rng = sh.AutoFilter.Range
' Check if there is any data in filter range
If rng.Rows.Count > 1 Then
Set rng = rng.Offset(1, 0).Resize(rng.Rows.Count - 1)
On Error Resume Next
Set rng = rng.SpecialCells(xlCellTypeVisible)
If Err.Number = 1004 Then
' No cells returned by filter
Exit Sub
End If
On Error GoTo 0
rng.Copy ActiveWorkbook.Worksheets("Sheet2").[A5]
End If
' remove filter
sh.AutoFilterMode = False
MessageBoxYesOrNoMsgBox
End Sub
