エクセル練習問題：フィルターオプションの設定（VBA)

問題　　　　topへ

• 問題1：B2:H21に売上表があります。担当者が「岡田」と「上村」のデータをB25セル以降に書き出しなさい。
  なお、この操作はフィルターオプションの設定で抽出するものとします。　　問題1の解答
  

  	B	C	D	E	F	G	H
  2	伝票��	日付	担当者	型番	単価	数量	売上金額
  3	1001	2006/1/1	岡田	A-001B	5,000	15	75,000
  4	1002	2006/1/1	上村	A-001W	5,000	22	110,000
  5	1003	2006/1/1	相沢	C-105W	8,000	14	112,000
  6	1004	2006/2/1	井上	B-022B	6,000	24	144,000
  7	1005	2006/2/1	相沢	A-001B	5,000	15	75,000
  8	1006	2006/2/1	岡田	A-001W	5,000	12	60,000
  9	1007	2006/3/1	上村	B-022B	6,000	13	78,000
  10	1008	2006/3/1	岡田	C-105B	8,000	12	96,000
  11	1009	2006/3/1	相沢	A-001W	5,000	16	80,000
  12	1010	2006/4/1	上村	B-033W	7,000	14	98,000
  13	1011	2006/4/1	相沢	C-105B	8,000	24	192,000
  14	1012	2006/4/1	岡田	B-033W	7,000	22	154,000
  15	1013	2006/5/1	井上	A-001B	5,000	13	65,000
  16	1014	2006/5/1	上村	C-105W	8,000	23	184,000
  17	1015	2006/5/1	井上	B-033W	7,000	14	98,000
  18	1016	2006/6/1	岡田	C-105B	8,000	18	144,000
  19	1017	2006/6/1	相沢	B-022B	6,000	19	114,000
  20
  21		合計					1,879,000

• 問題2：上記売上表から[型番」に「W」を含むデータを抽出しなさい。
  なお、この操作はフィルターオプションの設定で抽出するものとします。　　　問題2の解答
• 問題3：上記売上表から[担当者」が「岡田」で「売上金額」が「平均値より下」のデータを抽出しなさい。
  なお、この操作はフィルターオプションの設定で抽出するものとします。　　　問題3の解答

解答例　　　　topへ

問題1の解答例　　　　topへ

• 抽出結果
  

  	B	C	D	E	F	G	H
  25	伝票��	日付	担当者	型番	単価	数量	売上金額
  26	1001	2006/1/1	岡田	A-001B	5,000	15	75,000
  27	1002	2006/1/1	上村	A-001W	5,000	22	110,000
  28	1006	2006/2/1	岡田	A-001W	5,000	12	60,000
  29	1007	2006/3/1	上村	B-022B	6,000	13	78,000
  30	1008	2006/3/1	岡田	C-105B	8,000	12	96,000
  31	1010	2006/4/1	上村	B-033W	7,000	14	98,000
  32	1012	2006/4/1	岡田	B-033W	7,000	22	154,000
  33	1014	2006/5/1	上村	C-105W	8,000	23	184,000
  34	1016	2006/6/1	岡田	C-105B	8,000	18	144,000

1. コードの例1
   • 抽出条件をK2:K4に以下のように入力します。
     • これは完全一致で検索するためです。
     • 「岡田」と入力すると前方一致で検索されます。

     	K
     2	担当者
     3	="=岡田"
     4	="=上村"

   Sub Adfilter1() 　　Dim lrow As Long 　　'検索条件をセルに入力 　　Range("K2").Value = "担当者" 　　Range("K3").Formula = "=""=岡田""" 　　Range("K4").Formula = "=""=上村""" 　　'データの抽出先をクリアする 　　lrow = Range("B" & Rows.Count).End(xlUp) 　　If lrow > 25 Then 　　　　Range("B25:H" & lrow).ClearContents 　　End If 　　'フィルタオプションの設定でデータ抽出 　　Range("B2:H19").AdvancedFilter _ 　　　　　Action:=xlFilterCopy, _ 　　　　　CriteriaRange:=Range("K2:K4"), _ 　　　　　CopyToRange:=Range("B25"), _ 　　　　　Unique:=False End Sub

2. コードの例2
   • K2セルは空欄のままにします。もしくは、列見出しと重複しない文字列を入力します。
     操作手順等は省略します。
     K3セルに以下の数式を入力します。
     

     	K
     2
     3	=OR(D3="岡田",D3="上村")

   • Sub Adfilter2() 　　Dim lrow As Long 　　'検索条件をセルに入力 　　Range("K2").Value = "" 　　Range("K3").Formula = "=OR(D3=""岡田"",D3=""上村"")" 　　'データの抽出先をクリアする 　　lrow = Range("B" & Rows.Count).End(xlUp) 　　If lrow > 25 Then 　　　　Range("B25:H" & lrow).ClearContents 　　End If 　　'フィルタオプションの設定でデータ抽出 　　Range("B2:H19").AdvancedFilter _ 　　　　　Action:=xlFilterCopy, _ 　　　　　CriteriaRange:=Range("K2:K4"), _ 　　　　　CopyToRange:=Range("B25"), _ 　　　　　Unique:=False End Sub

問題2の解答例　　　　topへ

• 抽出結果
  

  	B	C	D	E	F	G	H
  25	伝票��	日付	担当者	型番	単価	数量	売上金額
  26	1002	2006/1/1	上村	A-001W	5,000	22	110,000
  27	1003	2006/1/1	相沢	C-105W	8,000	14	112,000
  28	1006	2006/2/1	岡田	A-001W	5,000	12	60,000
  29	1009	2006/3/1	相沢	A-001W	5,000	16	80,000
  30	1010	2006/4/1	上村	B-033W	7,000	14	98,000
  31	1012	2006/4/1	岡田	B-033W	7,000	22	154,000
  32	1014	2006/5/1	上村	C-105W	8,000	23	184,000
  33	1015	2006/5/1	井上	B-033W	7,000	14	98,000

1. コードの例1
   • 抽出条件をK2:K3に以下のように入力します。
     • これは完全一致で検索するためです。
     • 「岡田」と入力すると前方一致で検索されます。

     	K
     2	型番
     3	*W*

   • Sub Adfilter3() 　　Dim lrow As Long 　　'検索条件をセルに入力 　　Range("K2").Value = "型番" 　　Range("K3").Value = "*W*" 　　'データの抽出先をクリアする 　　lrow = Range("B" & Rows.Count).End(xlUp) 　　If lrow > 25 Then 　　　　Range("B25:H" & lrow).ClearContents 　　End If 　　'フィルタオプションの設定でデータ抽出 　　Range("B2:H19").AdvancedFilter _ 　　　　　Action:=xlFilterCopy, _ 　　　　　CriteriaRange:=Range("K2:K3"), _ 　　　　　CopyToRange:=Range("B25"), _ 　　　　　Unique:=False End Sub

2. コードの例2
   • K2セルは空欄のままにします。もしくは、列見出しと重複しない文字列を入力します。
     操作手順等は省略します。
     

     	K
     2
     3	=FIND("W",E3)

     • シート上の表示は以下のようにエラーになります。
       「W」を含むものは数値が返るので、この数式で抽出は可能です。
       

       	K
       2
       3	#VALUE!

   • Sub Adfilter4() 　　Dim lrow As Long 　　'検索条件をセルに入力 　　Range("K2").Value = "" 　　Range("K3").Value = "=FIND(""W"",E3)" 　　'データの抽出先をクリアする 　　lrow = Range("B" & Rows.Count).End(xlUp) 　　If lrow > 25 Then 　　　　Range("B25:H" & lrow).ClearContents 　　End If 　　'フィルタオプションの設定でデータ抽出 　　Range("B2:H19").AdvancedFilter _ 　　　　　Action:=xlFilterCopy, _ 　　　　　CriteriaRange:=Range("K2:K3"), _ 　　　　　CopyToRange:=Range("B25"), _ 　　　　　Unique:=False End Sub

問題3の解答例　　　　topへ

• 抽出結果
  

  	B	C	D	E	F	G	H
  25	伝票��	日付	担当者	型番	単価	数量	売上金額
  26	1001	2006/1/1	岡田	A-001B	5,000	15	75,000
  27	1006	2006/2/1	岡田	A-001W	5,000	12	60,000
  28	1008	2006/3/1	岡田	C-105B	8,000	12	96,000