Excel VBA檢查數據的自動篩選

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 

End Sub

感謝您的幫助傢伙。