VBA：自動篩選器不返回任何數據時的輸出消息框

Question

如果過濾后有任何結果，我想將自動過濾的范圍復制並粘貼到新的工作表中，如果沒有結果，則顯示一個消息框。

但是，當我使用不會返回任何結果的篩選條件進行測試時，不會出現消息框（顯示空白工作表）

    Dim WSNew As Worksheet
    Set WSNew = Worksheets.Add

    Dim rngVisible As Range
    Set rngVisible = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)

    If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
        rngVisible.Copy
            With WSNew.Range("A1")
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                .Select
            End With
    Else
        MsgBox ("No such filtered criteria")
    End If

Answer 1

首先您要在活動工作表中工作，但是在執行工作表時。添加的工作表可以成為活動工作表（取決於我認為的Excel版本）。 那可能是個問題。 因此，您必須設置一個WSOld並對其進行處理。

此外，您的自動篩選器功能的順序不正確（首先聲明Worksheet.Range（firstColumfirstLine：lastColumLastLine），然后對其自動篩選： https ://msdn.microsoft.com/fr-fr/library/office/ff193884.aspx ）。

您還必須選擇標准來過濾數據。

然后使用UsedRange.SpecialCells（xlCellTypeVisible）設置一個具有過濾單元格的范圍並在其上進行交互。

這對我有用：

 Dim WSOld As Worksheet
 Dim WSNew As Worksheet

'store the active sheet in WSOld to be sure that selection will be apply on it
Set WSOld = ActiveSheet
Set WSNew = Worksheets.Add

'select the range to apply the filter and choose criteria
WSOld.Range("A1:B6500").AutoFilter Field:=2, Criteria1:="te"

'select the data visible after filter
Dim rngVisible As Range
Set rngVisible = WSOld.UsedRange.SpecialCells(xlCellTypeVisible)

If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
    rngVisible.Copy
        With WSNew
            .Range("A1").PasteSpecial Paste:=8
            .Range("A1").PasteSpecial xlPasteValues
            .Range("A1").PasteSpecial xlPasteFormats
            Application.CutCopyMode = False
            .Select
        End With
Else
    MsgBox ("No such filtered criteria")
End If

'remove autofilter
WSOld.Range("A1:B6500").AutoFilter

希望能幫助到你。

Answer 2

請檢查以下內容：

Option Explicit
Sub Filter_range()


  Dim WSNew As Worksheet
  Dim rngVisible As Range




    Set rngVisible = ActiveSheet.AutoFilter.Range.SpecialCells(xlCellTypeVisible)

    If rngVisible.Rows.Count > 1 Or rngVisible.Areas.Count > 1 Then
        rngVisible.Copy

        Set WSNew = Worksheets.Add

            With WSNew.Range("A1")
                .PasteSpecial Paste:=8
                .PasteSpecial xlPasteValues
                .PasteSpecial xlPasteFormats
                Application.CutCopyMode = False
                .Select
            End With
    Else
        MsgBox ("No such filtered criteria")
    End If
End Sub