【マクロ】オートフィルター

✦集計シートの値でテーブル1をフィルターかける。

Dim sh1, sh2 As Worksheet
Set sh1 = Sheets("集計")
Set sh2 = Sheets("テーブル1")
If sh1.Range("A1") <> "" Then
sh2.Select
Selection.AutoFilter Field:=8, Criteria1:="=*" & sh1.Range("A1").Value & "*", Operator:=xlAnd
End If

------------------------------------------------------------------------------

✦アクティブなセルから100行までの空白以外でフィルターをかける。

Range(Selection, Selection.Offset(100, 0)).Select
Selection.AutoFilter Field:=1, Criteria1:="<>"

------------------------------------------------------------------------------

✦上の応用で1行目にフィルターを入れてアクティブセルの空白以外を絞り
　コピーする。

If Intersect(ActiveCell, Range("A1:Z1")) Is Nothing Then Exit Sub
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Copy
End With

------------------------------------------------------------------------------

✦シート２の特定セルの値でシート1表のフィルターをかける。

　この場合、シート2のB4・C4・D4の値でシート1を絞る。

With Sheets("Sheet1").Range("A1").CurrentRegion
.AutoFilter Field:=2, Criteria1:=Sheets("Sheet2").Cells(4, 2)
.AutoFilter Field:=7, Criteria1:=Sheets("Sheet2").Cells(4, 3)
.AutoFilter Field:=9, Criteria1:=Sheets("Sheet2").Cells(4, 4)
End With

------------------------------------------------------------------------------

✦1行目13列目で空白以外を絞り込む。

Worksheets("Sheet1").Range("A1").AutoFilter Field:=13, Criteria1:="<>"
Range("M1").Select 'コピーしたい列
With Range(ActiveCell, Cells(Rows.Count, ActiveCell.Column).End(xlUp))
.AutoFilter Field:=1, Criteria1:="<>"
.Copy
End With

------------------------------------------------------------------------------

✦フィルターをかけて可視セルをコピーする。

Range("A1").AutoFilter Field:=13, Criteria1:="<>"
 With ActiveSheet.AutoFilter.Range
   .Resize(.Rows.Count - 1).Offset(1).Select
 End With

------------------------------------------------------------------------------

✦オートフィルターの解除

With ActiveSheet
    If .FilterMode Then .ShowAllData
End With

------------------------------------------------------------------------------

✦1行目5列目でフィルターをかけたときに値がない場合。

Range("A1").AutoFilter Field:=5, Criteria1:="<>"
If ActiveSheet.AutoFilter.Range.Columns(1) _
.SpecialCells(xlCellTypeVisible).Count = 1 Then
MsgBox "データがありません"
Else
MsgBox "データがあります"
End If

------------------------------------------------------------------------------

✦シート2でフラグを立てた値でシート1をフィルターする。
　
　シート2でフラグを立ててシート1の表を絞り込む。
　シート2の5行目にフラグ用の値があるB列で絞りたい箇所に
　1を入れてフラグを立てる。
　フラグが立った月をシート1で表を絞り込む。

Sub sample()
Dim rngs As Range, rng As Range, xAry, i As Long
With Worksheets("Sheet2")
On Error Resume Next
Set rngs = .Range("C2:C" & Rows.Count).SpecialCells(xlCellTypeConstants)
On Error GoTo 0
End With
If Not rngs Is Nothing Then
ReDim xAry(1 To rngs.Cells.Count)
For Each rng In rngs
i = i + 1
xAry(i) = rng.Offset(, -1).Value
Next rng
Worksheets("Sheet1").Range("A:A").AutoFilter Field:=1, Criteria1:=xAry, Operator:=xlFilterValues
End If
End Sub

【シート2】フラグ用

	A	B
4	月	マーク
5	1月	1
6	2月
7	3月
8	4月
9	5月
10	6月
11	7月	1
12	8月
13	9月	1
14	10月
15	11月
16	12月

【シート2】表

	A	B	C	D	E
１	月	項目1	項目2	項目3	項目4
２	1月
３	3月
4	1月
5	7月
6	4月
7	12月
8	9月
9	1月
10	4月
11	6月
12	6月
13	11月

結果【シート1】

	A	B	C	D	E
１	月	項目1	項目2	項目3	項目4
２	1月
4	1月
5	7月
8	9月
9	1月