Excel VBAで数値の範囲を指定し抽出する｜AdvancedFilterを使用

Excel VBAを使い、数値の範囲を指定し抽出するにはAdvancedFilterを使用します。

Homeに戻る > Excel セルのTipsへ

数値の範囲を指定するというのは、例えば5～10のデータが含まれるレコードを抽出するということです。

AdvancedFilterメソッドの構文と引数については、「複数条件で抽出する方法｜AdvancedFilterを使用」を参照してください。

数値の範囲は、引数CriteriaRangeに「<>=」の数学記号を付けた、数値範囲が入力されているセルを指定します。

このページでは、MINとMAXのセルに入力した数値で抽出します。

Excel VBAでAdvancedFilterを使い、数値の範囲を指定し抽出する

Excel VBA シートコード

VBAの説明

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

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実行結果

No.が「3から100」までの条件で抽出した結果、2件見つかりました。

Homeに戻る > Excel セルのTipsへ

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