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 

の