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

首先要在活动表中工作，但是当您执行工作表时。这可能是一个问题。因此，您必须设置一个WSOLD并努力。

此外，您的自动滤波器函数不正确（首先声明Worksheet.range（firstColumFirstline：lastColumLastline），然后在其上自动滤波器：https：//msdn.microsoft.com/frosoft.com/fr-fr-fr/library/office/ff193884.aspx）。

您还必须选择标准来过滤数据。

，然后使用Usedrange.specialcells（Xlcelltyplevisible）与过滤单元设置范围并在其上进行交互。

这对我有用：

 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