#033

VBAでオートフィルタを操作したり、関数を使ってフィルタ用のコードを簡単にする方法などを詳しく説明しています。
■再生リスト
   • Excelパワークエリ  

   • Excelマクロ（VBA）  

   • Excel関数  

   • Excelピボットテーブル  

▼動画で説明しているサンプルコード、コピペ活用ください。
Sub ①オートフィルタで0以外を抽出する()
Range("A7").AutoFilter Field:=7, Criteria1:="＜＞0"
End Sub
-----------------------------
Sub ②オートフィルタで1を抽出する()
Range("A7").AutoFilter Field:=7, Criteria1:="1"
End Sub
-----------------------------
Sub ③オートフィルタで10以上50以下を抽出する()
Range("A7").AutoFilter Field:=5, Criteria1:="＞=10", Operator:=xlAnd, Criteria2:="＜=50"
End Sub
-----------------------------
Sub ④指定したシートのオートフィルタでりんごまたはばななを抽出する()
Range("A7").AutoFilter Field:=3, Criteria1:="=りんご", Operator:=xlOr, Criteria2:="=ばなな"
End Sub
-----------------------------
Sub ⑤テーブル形式のオートフィルタをクリアする()
Sheets("Sheet1").ListObjects("テーブル1").AutoFilter.ShowAllData
End Sub
-----------------------------
Sub ⑥範囲形式のオートフィルタをクリアする()
Sheets("Sheet3").AutoFilter.ShowAllData
End Sub
-----------------------------
Sub ⑦オートフィルタをセルの内容で抽出する()
Dim fil1 As Variant
Dim fil2 As Variant
Dim fil3 As Variant
fil1 = Sheets("Sheet2").Range("C4").Value
fil2 = Sheets("Sheet2").Range("C5").Value
fil3 = Sheets("Sheet2").Range("C6").Value

If Not fil1 = "" Then
'fil1がブランクじゃなかったらフィルタ実行
Sheets("Sheet1").Range("A7").AutoFilter Field:=2, Criteria1:=fil1
Else
'fil1がブランクの場合、フィルタ解除
Sheets("Sheet1").Range("A7").AutoFilter Field:=2
End If

If Not fil2 = "" Then
'fil２がブランクじゃなかったらフィルタ実行
Sheets("Sheet1").Range("A7").AutoFilter Field:=3, Criteria1:=fil2
Else
'fil２がブランクの場合、フィルタ解除
Sheets("Sheet1").Range("A7").AutoFilter Field:=3
End If

If Not fil3 = "" Then
'fil3がブランクじゃなかったらフィルタ実行
Sheets("Sheet1").Range("A7").AutoFilter Field:=4, Criteria1:=fil3
Else
'fil3がブランクの場合、フィルタ解除
Sheets("Sheet1").Range("A7").AutoFilter Field:=4
End If

End Sub
-----------------------------
Sub ⑧オートフィルタをSEARCH関数で抽出する()
' フィルタ実行
Sheets("Sheet1").Range("A7").AutoFilter Field:=7, Criteria1:="=1"
End Sub
-----------------------------
Sub オートフィルタをセルの内容で抽出したものをSheet２へ転記する()
' 検索ワードのセルを宣言
Dim fil1 As Variant
Dim fil2 As Variant
Dim fil3 As Variant
fil1 = Sheets("Sheet2").Range("C4").Value
fil2 = Sheets("Sheet2").Range("C5").Value
fil3 = Sheets("Sheet2").Range("C6").Value

' 最終行の変数
Dim maxRow1 As Long '転記先の最終行
Dim maxRow2 As Long '転記元の最終行
' 一つ下の行を選択する事で、抽出結果がゼロの場合に項目をクリアしない
maxRow1 = Sheets("Sheet2").Cells(Rows.Count, 2).End(xlUp).Offset(1, 0).Row
maxRow2 = Sheets("Sheet1").Cells(Rows.Count, 1).End(xlUp).Offset(1, 0).Row

' 前回のデータクリア
Range("B12:G" & maxRow1).Clear

' テーブル形式のオートフィルタをクリアする()
Sheets("Sheet1").ListObjects("テーブル1").AutoFilter.ShowAllData

' フィルタ実行
If Not fil1 = "" Then
'fil1がブランクじゃなかったらフィルタ
Sheets("Sheet1").Range("A7").AutoFilter Field:=2, Criteria1:=fil1
Else
'fil1がブランクの場合、フィルタを解除
Sheets("Sheet1").Range("A7").AutoFilter Field:=2
End If

If Not fil2 = "" Then
'fil２がブランクじゃなかったらフィルタ
Sheets("Sheet1").Range("A7").AutoFilter Field:=3, Criteria1:=fil2
Else
'fil２がブランクの場合、フィルタを解除
Sheets("Sheet1").Range("A7").AutoFilter Field:=3
End If

If Not fil3 = "" Then
'fil3がブランクじゃなかったらフィルタ
Sheets("Sheet1").Range("A7").AutoFilter Field:=4, Criteria1:=fil3
Else
'fil3がブランクの場合、フィルタを解除
Sheets("Sheet1").Range("A7").AutoFilter Field:=4
End If

' 抽出結果をコピー
Sheets("Sheet1").Range("A8:F" & maxRow2).Copy
' 抽出結果をペースト
Sheets("Sheet2").Range("B12").Select
ActiveSheet.Paste
Application.CutCopyMode = False
' 合計を追加
Dim maxRow3 As Long
maxRow3 = Sheets("Sheet2").Cells(Rows.Count, 5).End(xlUp).Row
Range("E" & maxRow3).Offset(1, 0) = "合計"
Range("F" & maxRow3).Offset(1, 0).Value = WorksheetFunction.Sum(Range("F3:F" & maxRow3))
Range("G" & maxRow3).Offset(1, 0).Value = WorksheetFunction.Sum(Range("G3:G" & maxRow3))
' 表示形式を変更
Range("F11:F" & maxRow3).Offset(1, 0).NumberFormatLocal = "#,##0" '桁区切り
Range("G11:G" & maxRow3).Offset(1, 0).NumberFormatLocal = "#,##0" '桁区切り
End Sub