Excel VBA：複数条件で抽出する方法｜AdvancedFilterを使用

Excel VBAを使い、複数条件で抽出するにはAdvancedFilterメソッドが必要です。

データを抽出するAdvancedFilterメソッド

構文：object.AdvancedFilter( Action[, CriteriaRange, CopyToRange, Unique] )

object：抽出元のセル範囲をRangeオブジェクトで指定します。
Action：抽出先をxlFilterAction列挙型の定数を使い指定します。
CriteriaRange：（省略可）抽出条件の範囲をRangeオブジェクトで指定します。省略すると抽出条件はなしになります。
CopyToRange：（省略可）ActionがXlFilterCopyの時に有効で、抽出先のセル範囲をRangeオブジェクトで指定します。
Unique：（省略可）重複データを抽出するかどうするかブール型の値で指定します。Trueの場合重複したデータは抽出されず、省略するかFalseの場合重複したデータも抽出されます。

xlFilterAction列挙型の定数

定数	値	説明
xlFilterInPlace	1	抽出元に表示します。
xlFilterCopy	2	引数のCopyToRangeで指定した範囲に抽出結果をコピーします。

関連するTipsの「あいまい抽出」も参照してください。

Excel VBAでAdvancedFilterを使い複数条件で抽出する

Excel VBA　シートコード

VBAの説明

［複数条件検索］ボタンをクリックすると、複数条件抽出のプロシージャを実行します。
抽出条件になる「名前」をB4セルからB12に、ワイルドカードの「*」を付けコピーします。
次の抽出条件になる「ナマエ」をC4セルからC12に、ワイルドカードの「*」を付けコピーします。
抽出条件をワイルドカードにしているので、文字が含まれるデータが抽出できます。
抽出結果を表示するセルをクリアします。CurrentRegion.ClearContentsでデータがあるセル範囲をクリアします。
抽出元のシートから、データが入力されている最下行を検索します。
AdvancedFilterを使い抽出を実行します。
object：抽出元のセル範囲は、データが入力されている最下行から作成しています。
Action：抽出先はxlFilterCopyを設定し、コピーし表示するようにします。
Criteriarange：抽出条件の範囲は最初にコピーした、B11:C12です。
Copytorange：抽出先はA20です。
Unique：Trueに設定しているので、重複したデータは抽出されません。
コピー先にデータがなければ「見つかりませんでした。」と表示します。
データがあれば、コピー先の最下行を検索し、そこから抽出件数を算出し表示します。
最初にコピーした抽出条件をクリアします。

Private Sub ExFind()
    Dim s As String
    Dim coun As Long
    Dim last As Long
    '抽出条件の作成
    If Range("B4") <> "" Then
        Range("B12") = "*" & Range("B4") & "*"
    End If
    If Range("C4") <> "" Then
        Range("C12") = "*" & Range("C4") & "*"
    End If

    '検索結果コピー領域のクリア
    Range("A20").CurrentRegion.ClearContents

    Sheets("Sheet2").Select
    ActiveSheet.Range("A1").Activate

    last = ActiveSheet.Range("A1").End(xlDown).Row

    '抽出しコピー
ActiveSheet.Range("A1:C" & last).AdvancedFilter Action:=xlFilterCopy, Criteriarange:=Range("B11:C12"), _
    copytorange:=Range("A20"), Unique:=False

    '結果表示
    Sheets("Sheet1").Select
    If Range("A21") = "" Then
        Range("B15") = "見つかりませんでした。"
    Else
        coun = Range("A20").End(xlDown).Row - 20
        Range("B15") = coun & " 件見つかりました。"
    End If

    '抽出条件のクリア
    Range("B12:C12") = ""
End Sub

Private Sub CommandButton1_Click()
    ExFind
End Sub

Sheet2にある、抽出対象データのExcelシート

Excel実行結果

名前に「木」、ナマエに「ユウ」が付いた複数条件で抽出した結果、1件見つかりました。

Homeに戻る > Excel セルのTipsへ

■■■
このサイトの内容を利用して発生した、いかなる問題にも一切責任は負いませんのでご了承下さい
■■■
当ホームページに掲載されているあらゆる内容の無許可転載・転用を禁止します