VBA_AutoFilter

やること

指定ファイルにフィルタを設定する関数を作成します。
関数を組み合わせることで、入力ファイルの必要な情報のみを抽出し、後続の転記処理等に繋げられます。

使用するもの

AutoFilterメソッド

任意のオプションを指定することで該当するデータを抽出します。
・Field：抽出条件を適用する列番号を指定。
・Criteria1：基準値（抽出する値）を指定。条件1。
・Operator：下記演算子を指定。

名称	値	説明
xlAnd	1	Criteria1とCriteria2どちらにも該当するものを表示
xlOr	2	Criteria1とCriteria2どちらかに該当するものを表示
xlTop10Items	3	上位n個のアイテムを表示（n = Criteria1）
xlBottom10Items	4	下位n個のアイテムを表示（n = Criteria1）
xlTop10Percent	5	上位n%のアイテムを表示（n = Criteria1）
xlBottom10Percent	6	下位n％のアイテムを表示（n = Criteria1）
xlFilterValues	7	Criteria1で指定した値が含まれる行を表示
xlFilterCellColor	8	Criteria1で指定したセルの背景色が含まれる行を表示
xlFilterFontColor	9	Criteria1で指定した文字色が含まれる行を表示
xlFilterIcon	10	Criteria1で指定したアイコンが含まれる行を表示
xlFilterDynamic	11	フィルタ条件を動的に設定

・Criteria2：基準値（抽出する値）を指定。条件2。
・SubField：抽出条件を適用するデータ型のフィールド。
・VisibleDropDown：指定した列番号のドロップダウン非表示

パターン別

下図の表のA列にフィルタを設定します。

同一列、条件1つ

Range("A9").AutoFilter 1, "*群馬県*"

同一列、条件2つ

Range("A9").AutoFilter 1, "*群馬県*", xlOr, "*栃木県*"

同一列、条件3つ以上

Dim arr(2) As Variant
arr(0) = "10_群馬県"
arr(1) = "09_栃木県"
arr(2) = "08_茨城県"
    
Range("A9").AutoFilter 1, arr, xlFilterValues

基準値に配列を使用すると、ワイルドカードを使用した抽出ができません。

補足

動的フィルタ

Cells(1, 1).AutoFilter 1, xlFilterThisMonth, xlFilterDynamic

第3引数(Operator)にxlFilterDynamicを指定することで動的フィルタを設定することができます。
第2引数(Criteria1)にxlFilterThisMonthを指定すると、下図のようにマクロ実行時の当月分のみ抽出されます。

複数列にフィルタを設定する場合

維持したいフィルタ第1引数のField部分の指定を変更します。

Range("A9").AutoFilter 1, "*群馬県*", xlOr, "*栃木県*"
Range("A9").AutoFilter 2, "*前橋市*", xlOr, "*宇都宮市*"

結果：

フィルタの解除

ActiveSheet.AutoFilterMode = False

フィルタ有無の確認

FilterModeプロパティで既にフィルタがかかっているかを確認できます。

    'フィルターモードの場合、フィルター解除
    If Worksheet.FilterMode Then
        Worksheet.AutoFilterMode = False
    End If

抽出結果の転記

手動操作と同様、フィルタ設定後に最下行を取得しコピペします。

Sub test()
    
    '変数定義
    Dim wkbInp      As Workbook
    Dim wksInp      As Worksheet
    Dim wksOut      As Worksheet
    Dim lngRowMax   As Long
    
    Set wkbInp = ThisWorkbook
    Set wksInp = wkbInp.Sheets("第１面事項_2020年")
    Set wksOut = wkbInp.Sheets("test")

    'フィルタ解除
    If ActiveSheet.FilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
    
    'フィルタ設定
    wksInp.Range("A9").AutoFilter 1, "*群馬県*", xlOr, "*栃木県*"
    
    '最下行取得
    lngRowMax = wksInp.Cells(Rows.Count, 1).End(xlUp).Row
    
    '転記
    wksInp.Range("A10:C" & lngRowMax).Copy
    wksOut.Range("A2").PasteSpecial xlPasteValues

    'フィルタ解除
    If ActiveSheet.FilterMode Then
        ActiveSheet.AutoFilterMode = False
    End If
End Sub

サンプル

個人的に使用しないSubField等は除きました。
抽出条件を含んだ配列のループ内で呼び出し、転記前の抽出設定として使用しています。

Function fncAutoFilter( _
    ByVal rngFilter As Range, _
    ByVal intField As Integer, _
    ByVal strCriteria1 As String, _
    ByVal intOperator As Integer, _
    ByVal strCriteria2 As String, _
    ByRef strMsgPrompt As String _
    )
    
    '変数定義
    Dim intRet      As Integer
    
    '初期設定
    On Error GoTo Err01
    
    'フィルタ設定
    If "" = strCriteria2 Then
        'Criteria1のみ
        rngFilter.AutoFilter intField, strCriteria1, intOperator
    Else
        'Criteria2有り
        rngFilter.AutoFilter intField, strCriteria1, intOperator, strCriteria2
    End If
    
    '終了
    Exit Function

Err01:
    intRet = Err.Number
    fncAutoFilter = intRet
    strMsgPrompt = "エラー番号：" & intRet & vbCrLf & _
                   "エラー内容：" & Err.Description

End Function

参考：

エンジニアファーストの会社 株式会社CRE-CO　S.K