エクセル ２００３ リストボックス複数選択後の処理

質問

いつもありがとうございます。
先日もご質問させていただきました。
エクセル　ＶＢＡ　初心者で困っております。

誠に申し訳ありませんが、ご教授をよろしくお願いします。

（sheet2）のデータをリストボックス（sheet1）で複数の値を選択し、

オートフィルタ－に反映させて抽出し、

その後、セルＢ１以下（sheet1）に入力した値と貼り付けた別のシート（sheet3）で数値１×数値２を掛け算し、数値３にそれぞれ出すのが目的です。

sheet1

リストボックスで複数選択された値を、Ａ１より下に貼り付けていく
それぞれＢ列に数値を入れる

例．（リストボックス選択後）

　　　　Ａ　　　　　Ｂ
１　　製品Ａ　 5（入力）
２　　製品Ｂ　 3（入力）
３　　製品Ｃ 2（入力）
・
・
・

コマンドボタン１を押すと実行

sheet2（今後増える可能性あり）

　　製品名　　　　　　数値1　　　　数値2　　　数値３

１　製品C　　　　　　　2　　　　 　　　　　
２　製品A　　　　　　　2
３　製品Ｅ　　　　　　　1
４　製品B　　　　　　　4
５　製品Ｆ　　　　　　　3
６　製品D　　　　　　　5
・
・
・

sheet3（貼付先）

実行結果

　　製品名　　　　　　数値1　　　　数値2　　　数値３　　 　　　　　
１　製品A　　　　　　　 2　　　　　　　　５　　　　　 10
２　製品Ｂ　　　　　　　 4　　　　　　　　3　　　　　 12
３　製品Ｃ 　 2 2 4

以前の質問では、１つずつでの入力で思ったとおりの結果になりました。
今回は複数です。

初心者で、まだ手を出す部分ではないとは思いますが、よろしくお願い致します。

回答No.2

keithin

丸投げで理解しようとしていない（理解するよりコタエ聞いてコピる方が手っ取り早い）ので応用も出来ません。という典型的なご質問です。

sub macro3()
　dim r as long
’準備
　worksheets("Sheet1").range("A1:B1") = array("製品名","数量2")
　worksheets("Sheet2").range("A1:B1") = array("製品名","数量1")
　worksheets("Sheet3").range("2:65536").entirerow.delete

’抽出と複写
　r = worksheets("Sheet1").range("A65536").end(xlup).row
　worksheets("Sheet2").range("A:B").advancedfilter _
　　action:=xlfiltercopy, _
　　criteriarange:=worksheets("Sheet1").range("A1:A" & r), _
　　copytorange:=worksheets("Sheet3").range("A1:B1")

’作表
　r = worksheets("Sheet3").range("A65536").end(xlup).row
　worksheets("Sheet3").range("C2:C" & r).formula = "=VLOOKUP(A2,Sheet1!A:B,2,FALSE)"
　worksheets("Sheet3").range("D2:D" & r).formula = "=B2*C2"
end sub

回答No.1

keithin

マクロ以前の準備：
０．シート１，２，３の１行目にタイトル行を記入し，２行目から実データを記入する
　　ご質問で書かれているような，いきなりシートの１行目からデータが記入されるような作り方はしない
１．シート１のＡ列に「入力規則」を取り付け，「商品名をプルダウンメニューから選べる」ように仕込んでおく
２．Ａ列で商品を選んだら，Ｂ列に数量を記入しておく

若しくはアナタの考えた「リストボックス」を利用してシート１に商品を記入できるよう準備する

マクロの用意：
次のマクロを参考にして，アナタの用意したボタンに取り付けて利用する

sub macro1()
　dim r as long
’準備
　worksheets("Sheet1").range("A1:B1") = array("製品名","数量2")
　worksheets("Sheet2").range("A1:B1") = array("製品名","数量1")
　worksheets("Sheet3").range("2:65536").entirerow.delete

’抽出と複写
　r = worksheets("Sheet1").range("A65536").end(xlup).row
　worksheets("Sheet2").range("A:A").advancedfilter _
　　action:=xlfiltercopy, _
　　criteriarange:=worksheets("Sheet1").range("A1:A" & r), _
　　copytorange:=worksheets("Sheet3").range("A1")

’作表
　r = worksheets("Sheet3").range("A65536").end(xlup).row
　worksheets("Sheet3").range("B2:B" & r).formula = "=VLOOKUP(A2,Sheet2!A:B,2,FALSE)"
　worksheets("Sheet3").range("C2:C" & r).formula = "=VLOOKUP(A2,Sheet1!A:B,2,FALSE)"
　worksheets("Sheet3").range("D2:D" & r).formula = "=B2*C2"
end sub

補足

keithinさん、
早速のご回答誠にありがとうございます。

おおむね、行いたいことが出来ました。
感謝致します。

ただ、１点だけ
Sheet2 には、製品名が同じで数量２が違う場合がございます。
そのまま実行すると、Sheet3には製品名はそれぞれで表記されますが、
数値２と３は、おそらくSheet1の一番上の製品の数値が反映されるようです。

ご教授をよろしくお願いいたします。