オートフィルタを使ってのデータ抽出マクロ

オートフィルタを使ってのデータ抽出マクロ

抽出したいとき、「データ」→「フィルタ」→「オートフィルタ」→商品名の所のフィルタ選択→「オプション」→ 条件名を入力し「を含む」を選択→「ＯＫ」としますが、いちいちオプションの設定がめんどーですねよ。「商品名抽出」というボタンを押し商品名を入力すると、入力した名前を含む一覧が表示されるようにすると、とっても便利です。
「商品抽出ボタン」を作って、ボタンに登録しちゃいましょう。

こんな一覧表の場合

Sub 商品名抽出()

     'マクロ実行画面の凍結
     Application.ScreenUpdating = False

     '変数宣言
     Dim 商品名 As Variant

     '抽出キーの入力指示
     商品名 = InputBox("抽出する商品名の一部を入力して下さい。")

     'キャンセルした場合の処理
     If 商品名 = Empty Then
         Exit Sub
     End If

     'オートフィルタがかかっていなかったらかける
     'かかっていたら念の為一度解除し再設定
     If ActiveSheet.AutoFilterMode = False Then
         Range("A3:D3").Select
         Selection.AutoFilter
     Else
         Selection.AutoFilter
         Range("A3:D3").Select
         Selection.AutoFilter
     End If

     Range("A3").Select

     '「商品名」の列（２列目）で、抽出キーを含むものを抽出
     Selection.AutoFilter Field:=2, _
         Criteria1:="=*" & 商品名 & "*", Operator:=xlAnd

End Sub

自動記録で行うと下記のように書かれます。

Sub 商品名抽出_自動記録()

     Range("A3:D3").Select
     Selection.AutoFilter
     Range("A3").Select
     Selection.AutoFilter Field:=2, _
         Criteria1:="=*あん*", Operator:=xlAnd

End Sub

■自動記録で書かれたものに手を入れる■

＜変数の設定＞
"=あん*"　の部分を変数にする
（"=*" & 商品名 & "*"）
     ↓
変数名を「商品名」とし、変数の宣言
（Dim 商品名 As Variant）
     ↓
「商品名」を聞いてくるBoxを作成
（商品名 = InputBox("抽出する商品名の一部を入力して下さい。")）

＜キャンセルした場合の処理＞
商品名を入力するBoxで、キャンセルした場合なにもしないようにする
     ↓
'キャンセルした場合の処理
If 商品名 = Empty Then
     Exit Sub
End If

＜オートフィルタをかけるかどうか＞
もし既にフィルタがかかっていたら、
一度解除し、再度フィルタをかける
     ↓
'オートフィルタがかかっていなかったらかける
'かかっていたら念の為一度解除し再設定
If ActiveSheet.AutoFilterMode = False Then
     Range("A3:D3").Select
     Selection.AutoFilter
Else
     Selection.AutoFilter
     Range("A3:D3").Select
     Selection.AutoFilter
End If

＜マクロ実行画面の凍結＞
この１行を書く事により、実行～結果までの工程が
表示されません。
この１行を書かないと、セルを選んだり、フィルタをかけたり
という動作が表示されます。

マクロ実行時間が少し短くなるのと、
目がチカチカしないのが利点です。
（Application.ScreenUpdating = False）

■■■抽出終了マクロ■■■

Sub 抽出終了()

     'マクロ実行画面の凍結
     Application.ScreenUpdating = False

     'フィルタがかかっていたら解除
     If ActiveSheet.AutoFilterMode = True Then
     Selection.AutoFilter
     End If

     Range("A3").Select

End Sub