Menuへ
複数条件での抽出




シートコード
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


抽出対象のデータ
抽出

実行結果
抽出結果



Topへ