1. Home » 
2. Excel講座の総目次 » 
3. Excel VBA入門：目次 » 
4. フィルタオプション(AdvancedFilter)でのデータ抽出

フィルタオプション(AdvancedFilter)でのデータ抽出:Excel VBA入門

フィルタオプション(AdvancedFilter)でのデータ抽出　　　Topへ

• データリストから必要なデータを抽出します。
  抽出条件をセルに書き出しておく必要があります。
  • 抽出条件の書き方はExcelのバージョンによって異なるので注意が必要です。
    Excel2002は完全一致、それ以外は前方一致になります。
    詳しくはデータ抽出の条件設定がバージョンによって異なるをご覧ください。
• expression.AdvancedFilter(Action, CriteriaRange, CopyToRange, Unique)

  • Action 必ず指定します	xlFilterCopy (値は2)	リスト範囲とは他の場所に抽出データをコピーします
    	xlFilterInPlace (値は1)	リスト範囲内にデータを抽出します
    CriteriaRange (省略可能)	Variant型の値を使用する	検索条件範囲を指定します。 省略すると、検索条件なしで抽出されます。
    CopyToRange (省略可能)	Variant型の値を使用する	引数 ActionがxlFilterCopyのときは、抽出された行のコピー先のセル範囲を指定します。 それ以外の場合、この引数は無視されます。
    Unique (省略可能)	True	検索条件に一致するレコードのうち、重複するレコードは無視されます。
    	FALSE	重複するレコードも含めて、検索条件に一致するレコードがすべて抽出されます。

• すべて表示するには　Activesheet.ShowAllData メソッドを使います。

1. 下記の表でフィルタオプションを使用してみます。
   

   出席番号	氏名	国語	算数	理科	社会	合計	順位	評価
   1001	佐藤	20	51	48	46	165	9	不可
   1002	鈴木	56	64	67	59	246	5	良
   1003	高橋	89	92	97	81	359	1	優
   1004	田中	71	78	75	85	309	4	良
   1005	渡辺	25	34	45	54	158	10	不可
   1006	伊藤	48	56	42	52	198	7	可
   1007	山本	92	88	84	76	340	2	優
   1008	中村	84	89	76	84	333	3	良
   1009	小林	61	59	65	54	239	6	可
   1010	加藤	34	47	38	49	168	8	可

2. 合計が300以上のデータをリスト内に抽出します。
   抽出条件をは1:B2セルに入力してあります。
   
   • コード例
     

     Sub Adfilter1() 　　Range("A4:I14").AdvancedFilter _ 　　　　Action:=xlFilterInPlace, _ 　　　　CriteriaRange:=Range("B1:B2"), _ 　　　　Unique:=False End Sub

   • 実行結果
     
3. 合計が300以上のデータをシート2のA1へ抽出します。
   • コード例
     

     Sub Adfilter2() 　　Range("A4:I14").AdvancedFilter _ 　　　　Action:=xlFilterCopy, _ 　　　　CriteriaRange:=Range("B1:B2"), _ 　　　　CopyToRange:=Worksheets("Sheet2").Range("A1"), _ 　　　　Unique:=False End Sub

   • 実行結果(Sheet2へ抽出した例)
     

他条件で繰り返し別シートへ抽出する場合　　　Topへ

• 抽出先に列見出しが入力済みの時は入力済みの列見出し範囲を指定する必要があります。
  • CopyToRange:=Worksheets("Sheet2").Range("A1")
    ↓
    CopyToRange:=Worksheets("Sheet2").Range("A1:I1")
• または、抽出先のデータをクリアしておくのも有効と思います。
  • 操作対象のワークシートを指定するのに注意が必要です。
    

    Sub Adfilter3() 　　Worksheets("Sheet2").Range("A:I").Clear 　　Worksheets("Sheet1").Range("A4:I14").AdvancedFilter _ 　　　　Action:=xlFilterCopy, _ 　　　　CriteriaRange:=Worksheets("Sheet1").Range("B1:B2"), _ 　　　　CopyToRange:=Worksheets("Sheet2").Range("A1"), _ 　　　　Unique:=False End Sub

    
    ↓
    

    Sub Adfilter4() 　　Worksheets("Sheet2").Range("A:I").Clear 　　With Worksheets("Sheet1") 　　　　.Range("A4:I14").AdvancedFilter _ 　　　　　　Action:=xlFilterCopy, _ 　　　　　　CriteriaRange:=.Range("B1:B2"), _ 　　　　　　CopyToRange:=Worksheets("Sheet2").Range("A1"), _ 　　　　　　Unique:=False 　　End With End Sub

まとめ　　　Topへ

• データリストがひとかたまりである場合、リスト範囲,条件範囲,抽出先を変数に割り当てておけば3行を変更するだけで流用できそうです。、
  • コード例
    

    Sub Adfilter5() 　　Dim dRng As Range, eRng As Range, cRng As Range 　　Set dRng = Worksheets("Sheet1").Range("A4").CurrentRegion 'データリスト 　　Set cRng = Worksheets("Sheet1").Range("B1:B2") '条件範囲 　　Set eRng = Worksheets("Sheet2").Range("A1") '抽出先 　　　　eRng.CurrentRegion.ClearContents 　　　　dRng.AdvancedFilter _ 　　　　　　Action:=xlFilterCopy, _ 　　　　　　CriteriaRange:=cRng, _ 　　　　　　CopyToRange:=eRng, _ 　　　　　　Unique:=False End Sub

特定の項目だけデータを抽出する　　　Topへ

• 特定の項目をSheet2へコピーしてから抽出します。
  抽出先でコピーした項目(列見出し)のセル範囲を指定します。
  • コード例
    

    Sub Adfilter6() 　　Worksheets("Sheet2").Range("A:I").Clear 　　With Worksheets("Sheet1") 　　　　.Range("A4:G4").Copy Worksheets("Sheet2").Range("A1") 　　　　.Range("A4:I14").AdvancedFilter _ 　　　　　　Action:=xlFilterCopy, _ 　　　　　　CriteriaRange:=.Range("B1:B2"), _ 　　　　　　CopyToRange:=Worksheets("Sheet2").Range("A1:G1"), _ 　　　　　　Unique:=False 　　End With End Sub

  • 実行結果
    

重複していないデータを抽出する　　　Topへ

• 下の住所リストから重複のないデータを取出します。

  • No	住所	姓
    1	鹿児島市千年1丁目1番	佐藤
    2	鹿児島市伊敷町1000番地	高橋
    3	鹿児島市下伊敷1000番地	高橋
    4	鹿児島市千年1丁目1番	佐藤
    5	鹿児島市下伊敷1002番地	中村
    6	鹿児島市下伊敷1003番地	伊藤
    7	鹿児島市千年1丁目1番	佐藤
    8	鹿児島市下伊敷1002番地	中村
    9	鹿児島市伊敷町1000番地	高橋

• コード例
  

  Sub Adfilter7() 　　With Worksheets("Sheet1") 　　　　.Range("B1:C10").AdvancedFilter _ 　　　　　　Action:=xlFilterCopy, _ 　　　　　　CopyToRange:=.Range("E1"), _ 　　　　　　Unique:=True 　　End With End Sub

• 実行結果
  

スポンサードリンク

PageViewCounter
　
　Since2006/2/27