VBA：自动filter不返回数据时的输出消息框

如果过滤后有任何结果，我想将自动过滤的范围复制并粘贴到新的工作表中，如果没有结果，则显示一个消息框。

但是，当我使用不会返回任何结果的筛选条件进行testing时，消息框不会显示（空白工作表显示）

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

首先，你想在活动工作表中工作，但是当你执行Worksheets.Add添加的工作表可以成为活动工作表（取决于我认为的Excel版本）。 这可能是一个问题。 所以你必须设置一个WSOld并在其上工作。

此外，您的自动筛选function不正确的顺序（首先声明Worksheet.Range（firstColumfirstLine：lastColumLastLine），然后自动过滤：https：//msdn.microsoft.com/fr-fr/library/office/ff193884.aspx ）。

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

然后使用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