【VBA】オートフィルターリスト化した抽出条件を使って抽出する

オートフィルタで抽出する時に、1つの列に設定する条件が不規則にたくさんある場合、便利なマクロを紹介します。

データと、抽出条件をリスト化したものを用意してください。

マクロで作るオートフィルタの抽出条件って、
・以下 or 以上
・の間
・含む or 含まない
などはよく使います。

1つの列に複数条件と言っても、
「A」か「B」を含む
など、2～3個の条件が多いですよね。

その時々によって変わる、しかも不規則な、大量の抽出条件かぁ。

任意の抽出条件をリストにする、もしくは、リスト化された何らかのデータを用意するところまではあらかじめ行ってください。

リストにした抽出条件を使って抽出する

シート「売上」

シート「リスト」

シート「売上」のB列「品目」のうち、シート「リスト」のA列にあるものに一致するものを抽出します。

VBA（Each～Next）

Sub 抽出1()

Dim myDic As Object, myKey As Variant
Dim c, varData As Variant

Set myDic = CreateObject(“Scripting.Dictionary”)

With Sheets(“リスト”)
   varData = .Range(“A2”, .Range(“A” & Rows.Count).End(xlUp)).Value
End With

For Each c In varData
   If Not c = Empty Then
      If Not myDic.Exists(c) Then
         myDic.Add c, Null
      End If
   End If
Next

myKey = myDic.Keys

Sheets(“売上”).Select
ActiveSheet.AutoFilterMode = False

Rows(“1:1”).AutoFilter 2, myKey, xlFilterValues

Set myDic = Nothing

End Sub

リスト中に重複がある場合、一つのものとする
リスト中に、一覧にはないものが含まれている場合、無視する

解説

空の辞書を作成する

シート「リスト」のA列（2行目から最終行まで）を取り出す
※varDataという箱に入れる

取り出したリストそれぞれにおいて
空白でなく、
すでにmyDicに存在しなければ（重複あるとエラーになるため）
myDicに追加する（myDicは連想配列）

myDicからキーを取り出して配列にする

シート「売上」のフィルターモードを解除する

B列において、リストと一致するものを抽出する

myDicを空にする

VBA（For～Next）

Sub 抽出2()

Dim myDic As Object, myKey As Variant
Dim List As String
Dim a As Long

Set myDic = CreateObject(“Scripting.Dictionary”)

a = Sheets(“リスト”).Cells(Rows.Count, 1).End(xlUp).Row

For i = 2 To a
   List = Sheets(“リスト”).Cells(i, 1)
   If Not List = Empty Then
      If Not myDic.Exists(List) Then
         myDic.Add List, Null
      End If
   End If
Next

myKey = myDic.Keys

Sheets(“売上”).Select
ActiveSheet.AutoFilterMode = False

Rows(“1:1”).AutoFilter 2, myKey, xlFilterValues

Set myDic = Nothing

End Sub