1. Home » 
2. Excel講座の総目次 » 
3. Excel VBA入門：目次 » 
4. Excel VBA プログラミング入門：目次 » 
5. オートフィルタでデータを抽出し、別シートに貼り付ける

オートフィルタでデータを抽出し、別シートに貼り付ける:Excel VBA プログラミング入門

はじめに

• このページでは以下のデータを利用して説明します。
  

  	A	B	C	D	E
  1	日付	商品名	単価	数量	金額
  2	2010/5/4	みかん	120	12	1,440
  3	2010/4/1	りんご	150	15	2,250
  4	2010/4/1	バナナ	120	10	1,200
  5	2010/4/2	みかん	110	20	2,200
  6	2010/4/2	りんご	150	10	1,500
  7	2010/4/2	バナナ	120	15	1,800
  8	2010/4/2	なし	150	20	3,000
  9	2010/5/1	りんご	150	30	4,500
  10	2010/5/1	バナナ	120	25	3,000
  11	2010/5/1	なし	160	20	3,200
  12	2010/5/2	りんご	145	35	5,075
  13	2010/5/2	みかん	120	40	4,800
  14	2010/5/2	バナナ	115	25	2,875

オートフィルタでデータを抽出する

商品名でデータを抽出する

• 商品名が「りんご」のデータを抽出します。
  • データ範囲はExcelに自動で認識してもらおうと考え、A1セルを指定してオートフィルタをかけました。
    抽出条件はField:=2, Criteria1:="りんご"と指定しています。
    

    Sub prog4_1() 　　Worksheets("データ").Range("A1").AutoFilter Field:=2, Criteria1:="りんご" End Sub

  • 実行結果
    

商品名をインプットボックスで指定する

• 抽出条件をコード内で指定していると、条件を変えたいときにコードを書き換えることになり、ちょっと面倒です。
  フィールドと検索する語句をインプットボックスで入力することにします。
  • フィールドはデータリストの何列目かを入力します。
    

    Sub prog4_1() 　　Dim myFld As String, myCri As String 　　Dim myRow As Long 　　　　myFld = InputBox("検索は何列目ですか?") 　　　　myCri = InputBox("検索する語句を入力しなさい") 　　　　Worksheets("データ").Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri End Sub

  • 「商品名」は2列目ですので「2」と入力します。
    
  • 検索する語句「りんご」と入力します。
    
  • 該当するデータが抽出されました。
    

抽出したデータを別のシートへコピーして貼り付けます

• 抽出されてデータの最終行を求めます。
  • オートフィルタがかかっている時は非表示行は無視されますので、.End(xlUp)を使って求めることができます。
    myRow = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row
• 抽出データを別シートにコピーして貼り付けます。
  • 貼り付け先にデータが残っていると、貼り付け後にも前のデータが残ってしまうことがありますので、最初にクリアします。
    貼り付け先の「抽出」シートのA:E列をクリアします。
    Worksheets("抽出").Range("A:E").ClearContents
  • 今回は列見出しも含めてコピーしたいので、セル範囲はA1から始まります。
    最終行はmyRowで求めているのでセル範囲はRange("A1:E" & myRow)となります。
    貼り付け先は「抽出」シートのA1セルからとします。
    Worksheets("データ").Range("A1:E" & myRow).Copy Worksheets("抽出").Range("A1")
  • 貼り付け後はフィルタを解除します。
    Worksheets("データ").Range("A1").AutoFilter
• フィールドはデータリストの何列目かを入力します。
  

  Sub prog4_1() 　　Dim myFld As String, myCri As String 　　Dim myRow As Long 　　　　myFld = InputBox("検索は何列目ですか?") 　　　　myCri = InputBox("検索する語句を入力しなさい") 　　　　'オートフィルタでデータを抽出する 　　　　Worksheets("データ").Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri 　　　　’抽出データの最終行を求める 　　　　myRow = Worksheets("データ").Range("A" & Rows.Count).End(xlUp).Row 　　　　'抽出先をクリアする 　　　　Worksheets("抽出").Range("A:E").ClearContents 　　　　'抽出データをコピーして貼り付け 　　　　Worksheets("データ").Range("A1:E" & myRow).Copy Worksheets("抽出").Range("A1") 　　　　'オートフィルタを解除 　　　　Worksheets("データ").Range("A1").AutoFilter 　　　　'抽出先シートをアクティブにしてA1セルを選択する 　　　　Worksheets("抽出").Activate 　　　　Range("A1").Select End Sub

  • 見やすくまとめると以下のようになります。
    

    Sub prog4_2() 　　Dim myFld As String, myCri As String 　　Dim myRow As Long 　　Dim Sh2 As Worksheet, Sh3 As Worksheet 　　　　Set Sh2 = Worksheets("データ") 　　　　Set Sh3 = Worksheets("抽出") 　　　　myFld = InputBox("検索は何列目ですか?") 　　　　myCri = InputBox("検索する語句を入力しなさい") 　　　　With Sh2 　　　　　　.Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri 　　　　　　myRow = .Range("A" & Rows.Count).End(xlUp).Row 　　　　　　Sh3.Range("A:E").ClearContents 　　　　　　.Range("A1:E" & myRow).Copy Sh3.Range("A1") 　　　　　　.Range("A1").AutoFilter 　　　　End With 　　　　Worksheets("抽出").Activate 　　　　Range("A1").Select End Sub

• 実行後の「抽出」シート
  

スポンサードリンク

PageViewCounter
　
　Since2006/2/27