エクセル練習問題：フィルター(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. コードの例
   

   Sub filter01() 　　Dim myRange As Range 　　Application.ScreenUpdating = False 　　Set myRange = Worksheets("Sheet1").Range("B2:H19") 　　'フィルターがかかっていたらオフにします 　　With Worksheets("Sheet1") 　　　　If .AutoFilterMode Then 　　　　　　.AutoFilterMode = False 　　　　End If 　　　　'オートフィルターをかけます 　　　　myRange.AutoFilter _ 　　　　　　　　　　　Field:=3, _ 　　　　　　　　　　　Criteria1:="岡田", Operator:=xlOr, _ 　　　　　　　　　　　Criteria2:="上村" 　　　　'抽出データをコピー&貼り付けします 　　　　myRange.SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet1").Range("B25") 　　　　.AutoFilterMode = False 　　End With ' 　　Application.ScreenUpdating = True 　　Set myRange = Nothing 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. コードの例
   

   Sub filter02() 　　Dim myRange As Range 　　Application.ScreenUpdating = False 　　Set myRange = Worksheets("Sheet1").Range("B2:H19") 　　'フィルターがかかっていたらオフにします 　　With Worksheets("Sheet1") 　　　　If .AutoFilterMode Then 　　　　　　.AutoFilterMode = False 　　　　End If 　　　　'オートフィルターをかけます 　　　　myRange.AutoFilter _ 　　　　　　　　　　Field:=4, _ 　　　　　　　　　　Criteria1:="*W*" 　　　　'抽出データをコピー&貼り付けします 　　　　myRange.SpecialCells(xlCellTypeVisible).Copy Worksheets("Sheet1").Range("B25") 　　　　.AutoFilterMode = False 　　End With ' 　　Application.ScreenUpdating = True 　　Set myRange = Nothing 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