Question

我需要帮助检查自动过滤的行，不包括标题。我希望它给出一个消息框“找不到记录。”如果标题行之外有行，则退出sub或继续复制粘贴。我知道在过滤器之后需要一个If / Else条目来检查数据，但我无法确定如何检查。此代码是从我创建的UserForm按钮完成的。

这是我的剧本：

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重构演示使用过滤器范围的方法。同时也不需要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

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

再次感谢您的帮助。

Answer 5

我为此找到了解决方案。尝试此解决方案。

Dim count As Long
count = Application.WorksheetFunction.count(rng_SmPrt.SpecialCells(xlCellTypeVisible))

这一行正确返回可见行的数量。

Excel VBA检查自动筛选器的数据

5 个答案: