オートフィルタでデータを抽出し、別シートに貼り付ける(コンボボックス使用) |
スポンサードリンク | |
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 lRow As Long Dim i As Long, myCnt As Long Dim myData With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row myData = .Range("A2:A" & lRow).Value End With With ComboBox1 .List = myData End With End Sub |
Sub myform2() Load UserForm2 UserForm2.Show End Sub |
'CommandButton1でオートフィルターでデータを抽出します Private Sub CommandButton1_Click() Dim myFld As String, myCri As String Dim myRow As Long Dim Sh2 As Worksheet, Sh3 As Worksheet Dim lRow As Long Dim myData 'コンボボックスで何も選択されていないときの処理 If UserForm2.ComboBox1.ListIndex < 0 Then MsgBox "いずれかの行を選択してください" Exit Sub End If '商品名リストを配列myDataに読み込む With Worksheets("Sheet2") lRow = .Range("A" & Rows.Count).End(xlUp).Row myData = .Range("A2:A" & lRow).Value End With Set Sh2 = Worksheets("Sheet1") Set Sh3 = Worksheets("Sheet3") myFld = 2 '2列目をキーとする 'コンボボックスで選択している商品名を変数myCriに読み込み、キーとする myCri = myData(UserForm2.ComboBox1.ListIndex + 1, 1) 'オートフィルターでデータを抽出する With Sh2 .Range("A1").AutoFilter Field:=myFld, Criteria1:=myCri myRow = .Range("A" & Rows.Count).End(xlUp).Row ’抽出先のSh3をクリアする Sh3.Range("A:E").ClearContents ’抽出データをSh3へコピー&貼り付けする .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