Excel VBA检查数据的自动筛选

我需要帮助检查不包括标题的自动筛选的行。 我希望它给一个消息框“找不到logging”。 然后退出sub或继续复制粘贴，如果有超出标题行的行。 我知道我需要一个If / Else条目来筛选数据，但我无法确定如何检查。 此代码正在从我创build的用户窗体button完成。

这是我的脚本：

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 

任何帮助将不胜感激。

Answer 1

见下面，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 

Answer 2

对行进行计数，或者检查最后一行是否为标题

 if application.worksheetfunction.subtotal(3,activesheet.columns(1))>1 then msgbox "Records" else msgbox "No Records" end if 

检查最后一行

 if activesheet.cells(rows.count,1).end(xlup).row>1 then msgbox "Records" else msgbox "No Records" end if 

Answer 3

这是你的maco重构演示使用filter范围的方法。 也删除了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 

Answer 4

对于需要这个的任何人，我结束了使用：

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 

结束小组

再次感谢您的帮助。