【Excel VBA】Filter関数で特定のデータを抽出する方法

Excel VBAで条件に一致したデータを抽出したい場合はありませんか？

今回はワークシート(WorksheetFunction)関数のFilter関数を用いて、条件に一致するデータを抽出する方法を説明していきます。

基本的な構文

WorksheetFunction.Filterは以下の構文で使用可能です。

WorksheetFunction.Filter(抽出対象のRangeオブジェクト, Evaluate(抽出条件の数式文字列))

使用例

データを抽出するサンプルです。

以下の画像の表に対して、データを抽出しています。

単一条件の場合

単一条件の場合は数式文字列はそのままでOKです。

例

以下の例では、個数が50以上の品目名を抽出しています。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    result = WorksheetFunction.Filter(itemNameRange, _
    Evaluate(itemNameRange.Offset(0, 1).Address & ">=50"))
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub

出力結果

オレンジ
レモン

AND条件の場合

AND条件の場合は、数式を条件ごとに丸括弧で囲み「*」で区切る必要があります。

"(条件1)" & "*" & "(条件2)"

例

以下の例では、個数が30～50の間の品目名を抽出しています。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    result = WorksheetFunction.Filter(itemNameRange, _
    Evaluate("(" & itemNameRange.Offset(0, 1).Address & ">=30" & ")" & _
    "*" & "(" & itemNameRange.Offset(0, 1).Address & "<=50" & ")"))
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub

出力結果

レモン
パイナップル

OR条件の場合

AND条件の場合は、数式を条件ごとに丸括弧で囲み「+」で区切る必要があります。

"(条件1)" & "*" & "(条件2)"

例

以下の例では、個数が10または50の間の品目名を抽出しています。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    result = WorksheetFunction.Filter(itemNameRange, _
    Evaluate("(" & itemNameRange.Offset(0, 1).Address & "=10" & ")" & _
    "+" & "(" & itemNameRange.Offset(0, 1).Address & "=50" & ")"))
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub

出力結果

ドラゴンフルーツ
レモン
メロン

ワイルドカードを使用する場合

ワイルドカードを使用する場合は、COUNTIFSを使用します。

検索対象のアドレスは、3つとも同じアドレスを指定する必要があります。

COUNTIFS(検索対象のアドレス,検索対象のアドレス,検索対象のアドレス,パターン文字列)

例

以下の例では、末尾が「ン」の品目名を抽出しています。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    With itemNameRange
        result = WorksheetFunction.Filter(itemNameRange, _
        Evaluate("COUNTIFS(" & .Address & "," & .Address & "," & .Address & "," & """=*ン""" & ")"))
    End With
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub

出力結果

レモン
メロン

使用上の注意点

Filter関数を使用する上での注意点について説明します。

抽出対象の表は「使用例」と同じです。

抽出結果が1件の場合

抽出結果が1件の場合、添字で配列を参照している場合はエラーが発生します。

これは、抽出結果が1件の場合のみ1次元配列で返却されることが原因です。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    result = WorksheetFunction.Filter(itemNameRange, Evaluate(itemNameRange.Offset(0, 1).Address & ">=60"))
     '抽出結果をイミディエイトに出力
    Dim i As Integer
    For i = 1 To UBound(result)
        Debug.Print result(i, 1) 'ここでエラーが発生
    Next
End Sub

対処法

抽出結果が1件の場合は、二次元配列に変換する処理を加えれば解決します。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim tmpResult As Variant
    tmpResult = WorksheetFunction.Filter(itemNameRange, Evaluate(itemNameRange.Offset(0, 1).Address & ">=60"))
    '抽出結果が1件の場合は二次元配列に変換
    Dim i As Long
    Dim result As Variant
    If UBound(tmpResult, 1) > 1 Then
        result = tmpResult
    Else
        ReDim result(1 To 1, 1 To 1)
        result(1, 1) = tmpResult(1)
    End If
     '抽出結果をイミディエイトに出力
    For i = 1 To UBound(result)
        Debug.Print result(i, 1)
    Next
End Sub

抽出結果

オレンジ

抽出結果が0件の場合

出力結果が0件の場合はFilter関数実行時にエラーが発生します。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    result = WorksheetFunction.Filter(itemNameRange, Evaluate(itemNameRange.Offset(0, 1).Address & ">=100")) 'ここでエラーが発生
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub

対処法

例外処理でエラー時の処理を指定すれば解決します。

以下の例では、抽出結果が0件の場合は出力処理を実行しないようにしています。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    On Error Resume Next 'エラーを無視する
    result = WorksheetFunction.Filter(itemNameRange, Evaluate(itemNameRange.Offset(0, 1).Address & ">=100"))
    If Err.Number > 0 Then Exit Sub  '見つからない場合は終了
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub

出力対象の行範囲と数式内の行範囲が一致しない

出力対象の行範囲と数式内の行範囲が一致しない場合はエラーが発生します。

Sub Macro1()
    '品目名の開始行から終了行までの範囲セット
    Dim itemNameRange As Range
    Set itemNameRange = Range(Cells(2, 1), Cells(Cells(Rows.Count, 1).End(xlUp).Row, 1))
    '条件に合致する品目名を取得する
    Dim result As Variant
    result = WorksheetFunction.Filter(itemNameRange, _
    Evaluate(itemNameRange.Resize(1, 1).Offset(0, 1).Address & ">=50")) 'ここでエラーが発生
     '抽出結果をイミディエイトに出力
    Dim eachData As Variant
    For Each eachData In result
        Debug.Print eachData
    Next
End Sub