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

• オートフィルターを使ってデータを抽出する例で、抽出するキーをリストボックスで選択する方法です。

はじめに

• Sheet1にデータがあります。このデータから商品名を指定してSheet3へデータを抽出します。
  Sheet1に配置したボタンをクリックすると、UserForm1が表示されます。
  リストボックスから商品名「バナナ」を選択してコマンドボタン「auto filter」をクリックします。
  
• Sheet3へ商品名が「バナナ」のデータが振り分けられました。
  
• このページでは以下のデータを利用しています。
  

  	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

ユーザーフォームを作成する

• Atl+F11でVBEを開きます。
  [ユーザーフォームの挿入]ボタンをクリックして、UserForm1を挿入しました。
  ListBox1とCommandButton1とCommandButton2を配置しました。（コマンドボタンのキャプションは適宜変更してください。)
  

商品名をリストボックスに表示する

• ここでは商品名のデータをSheet2へ書き出しておきます。
  Sheet1のB列を選択して、Sheet2へ貼り付けます。[データ]タブの[重複の削除]を実行するとリストが作成できます。
  
• ユーザーフォームを開いたときにリストボックスの商品名を表示するために　UserForm_Initialize　に下記のようなコードを書きます。
  

  Private Sub UserForm_Initialize() 　　Dim lastRow As Long 　　Dim myData 　　With Worksheets("Sheet2") 　　　　myData = .Range(.Cells(2, 1), .Cells(Rows.Count, 1).End(xlUp)).Value 　　End With 　　With ListBox1 　　　　.List = myData 　　End With End Sube

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

• コマンドボタンのコードを下記のように記述します。
  

  'CommandButton1でオートフィルターでデータを抽出します Private Sub CommandButton1_Click() 　　Dim myFld As String, myCri As String 　　Dim myRow As Long 　　Dim Sh2 As Worksheet, Sh3 As Worksheet 　　Set Sh2 = Worksheets("Sheet1") 　　Set Sh3 = Worksheets("Sheet3") 　　　'オートフィルターの検索する列(キー)を2と指定しています 　　myFld = 2 '2列目をキーとする 　　　'リストボックスの選択している値を取得する 　　myCri = UserForm1.ListBox1.Value 　　With Sh2 　　　　’Sh2のデータをオートフィルターする 　　　　.Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri 　　　　myRow = .Range("A" & Rows.Count).End(xlUp).Row 　　　　'書き出すシートSh3のセルををクリアする 　　　　Sh3.Range("A:E").ClearContents 　　　　'抽出したデータをコピーして貼り付ける 　　　　.Range("A1:E" & myRow).Copy Sh3.Range("A1") 　　　　'オートフィルターを解除する 　　　　.Range("A1").AutoFilter 　　End With 　　Sh3.Activate 　　Range("A1").Select End Sub 'CommandButton2でユーザーフォームを閉じます Private Sub CommandButton2_Click() 　　Unload Me End Sub

スポンサードリンク

PageViewCounter
　
　Since2006/2/27