VBA~複数の条件を指定してデータを抽出しよう~Excel
複数の条件を指定してデータを抽出したい時はRange.AutoFilterメソッドを使います。
1つのフィールドから2つの条件で抽出する場合
Rangeオブジェクトでリストの左上のセルを指定するとリストを指定できます。パラメーターFieldでフィールド番号を指定します。フィールド番号はリストの左から始まります。つまり下の画像の例ではフィールド番号1は名前の項目になります。パラメーターCriteria1、Criteria2で抽出条件を指定します。抽出条件は文字列で"=文字列"というように指定します。例えば下の画像の例で班の項目で"=1班"と指定すれば1班の人のデータだけが抽出されます。2つの条件をしていするのでOreratorで演算子を指定します。どちらか一方でも満たせば抽出する場合は"または"を表すxlOrを指定します。下のコードを実行するとフィールド番号1、つまりリスト左から1番目の名前の項目のBさんとCさんのデータが抽出され、CurrentRegion.Copyで抽出されたデータをSheet2にコピーしています。
Sub test1() With Worksheets("Sheet1").Range("A1") .AutoFilter Field:=1, Criteria1:="=Bさん", Operator:=xlOr, Criteria2:="Cさん" .CurrentRegion.Copy Worksheets("Sheet2").Range("A1") End With End Sub
2つのフィールドからそれぞれ条件を指定して抽出する場合
2つのフィールドからそれぞれ条件を指定して抽出する場合、コードにAutoFileterを2つ書きます。下のコードを実行すると1班の男性が抽出されます。
Sub test2() With Worksheets("Sheet1").Range("A1") .AutoFilter Field:=2, Criteria1:="=1班" .AutoFilter Field:=3, Criteria1:="=男性" .CurrentRegion.Copy Worksheets("Sheet2").Range("A1") End With End Sub
1つのフィールドから3つ以上の条件で抽出する場合
1つのフィールドから3つ以上の条件で抽出する場合、配列を使います。Dim ListArray1(2) As Stringと宣言することで、ListArray1(0)、ListArray1(1)、ListArray1(2)という3つの名前を格納できる入れ物ができるので、それぞれに条件を入れています。Criteria1:=ListArray1で3つの条件が入ります。Operator:=xlFilterValuesはフィルターの値を意味します。実行するとフィールド1の名前の項目からAさん、Bさん、Cさんのデータが抽出されます。
Sub test3() Dim ListArray1(2) As String ListArray1(0) = "Aさん" ListArray1(1) = "Bさん" ListArray1(2) = "Cさん" With Worksheets("Sheet1").Range("A1") .AutoFilter Field:=1, Criteria1:=ListArray1, Operator:=xlFilterValues .CurrentRegion.Copy Worksheets("Sheet2").Range("A1") End With End Sub
複数のフィールドから3つ以上の条件で抽出する場合
複数のフィールドから3つ以上の条件で抽出する場合、配列を複数宣言しそれぞれの入れ物に条件となる文字列を格納し、コードに.AutoFilterを複数書けば抽出できます。下のコードを実行するとカラーボールくじにおいてフィールド番号2の一回目の項目から赤、オレンジ、黄を引いた人が抽出され、その中から次に二回目の項目から緑、青、紫を引いた人を抽出します。
Sub test4() Dim ListArray1(2) As String Dim ListArray2(2) As String ListArray1(0) = "赤" ListArray1(1) = "オレンジ" ListArray1(2) = "黄" ListArray2(0) = "緑" ListArray2(1) = "青" ListArray2(2) = "紫" With Worksheets("Sheet1").Range("A3") .AutoFilter Field:=2, Criteria1:=ListArray1, Operator:=xlFilterValues .AutoFilter Field:=3, Criteria1:=ListArray2, Operator:=xlFilterValues .CurrentRegion.Copy Worksheets("Sheet2").Range("A1") End With End Sub