オートフィルタでデータを抽出し、別シートに貼り付ける(リストボックス使用) |
スポンサードリンク | |
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 |
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