エクセル ＶＢＡ 初心者で困っております！

質問

いつもありがとうございます。VBA初心者です。
データベース（sheet2）のデータをセルＡ１（sheet1）の値をオートフィルタ－に反映させて抽出し、

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

sheet1

セルA１【製品名を入力】例、【製品Ａ】を入力
セルB1【数値を入力】例、５を入力
コマンドボタン１を押すと実行

sheet2（データベース）

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

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

sheet3（貼付先）

実行結果

　　製品名　　　　　　数値1　　　　数値2　　　数値３　　 　　　　　
１　製品A　　　　　　　2　　　　　　　　５　　　　　１０
２　製品A　　　　　　　1　　　　　　　　５　　　　　 ５

当初、リストボックスを選択出来るようにし、その値を別のシートに貼り付け、演算処理を行うの方法を模索しておりましたが、
shee2のデータベース、Ａ１・Ｂ１（検索値・値）も毎回変わるため、１回ずつの作業を行うように考えなおしたところ、
いきずまってしましました。

時間がないためによろしくお願い致します。

回答No.1

keithin · ベストアンサー

下記を下敷きにして，改めてご自分の使いやすいように作成し直してみてください。

sub macro1()
　dim lastrow_at3 as long
　worksheets("Sheet3").range("A:D").clearcontents

’オートフィルタで絞り込みコピーする（記録マクロと同じ）
　worksheets("Sheet2").range("A:D").autofilter field:=1, criteria1:=worksheets("Sheet1").range("A1")
　worksheets("Sheet2").autofilter.range.copy destination:=worksheets("Sheet3").range("A1")

’シート３のＣ列Ｄ列に必要な記入を行う（記録マクロと同じ）
　lastrow_at3 = worksheets("Sheet3").range("A65536").end(xlup).row
　worksheets("Sheet3").range("C2:C" & lastrow_at3).value = worksheets("Sheet1").range("B1")
　worksheets("Sheet3").range("D2:D" & lastrow_at3).formula = "=B2*C2"
end sub

お礼

早速にご回答ありがとうございました。
お陰様で期日までになんとか間に合いました。

他にも、ご回答を頂きましたが、ベストアンサーにさせて頂きます。
ありがとうございました。

回答No.3

tom04

こんばんは！
すでに回答は出ていますので、参考程度で・・・
オートフィルタではなく、For～Next　でやっています。
コマンドボタンはSheet1にあるとし、Sheet3の1行目・項目は入力済だとします。

Private Sub CommandButton1_Click()
Dim i As Long
Dim ws2, ws3 As Worksheet
Set ws2 = Worksheets(2)
Set ws3 = Worksheets(3)
Application.ScreenUpdating = False
i = ws3.Cells(Rows.Count, 1).End(xlUp).Row
If i > 1 Then
ws3.Rows(2 & ":" & i).ClearContents
End If
For i = 2 To ws2.Cells(Rows.Count, 1).End(xlUp).Row
If ws2.Cells(i, 1) = Cells(1, 1) Then
With ws3.Cells(Rows.Count, 1).End(xlUp).Offset(1)
.Value = ws2.Cells(i, 1)
.Offset(, 1) = ws2.Cells(i, 2)
.Offset(, 2) = Cells(1, 2)
.Offset(, 3) = ws2.Cells(i, 2) * Cells(1, 2)
End With
End If
Next i
Application.ScreenUpdating = True
End Sub

こんな感じではどうでしょうか？m(_ _)m

お礼

ご回答、ありがとうございます。
コードの意味を理解して、また勉強し直します。
ありがとうございました。

回答No.2

imogasi

初心者がリストボックスを・・など難しいことを考えすぎ。
丸投げで、時間が゛無いなんて言っているが、自分で少しづつやるべき。
解答を人にたよりすぎ。
それまでは手作業（検索やフィルタ・コピー）でやること。
マクロの記録でも取れば、修正箇所の質問だけになるだろう。それさえも気がついてないのでっは。
もっと初心者は初心者らしい仕組みとプログラムで動かすべきだろう。
例データ
Ｓｈｅｅｔ１
Ａ１に製品名　
製品A
を入力
コマンドボタンを１つ貼り付け。
ーー
Ｓｈｅｅｔ２Ａ１：Ｂ６
製品C 2
製品A 2
製品A 1
製品B 4
製品D 3
製品D 5
ーー
コード
Private Sub CommandButton1_Click()
x = Worksheets("Sheet1").Range("A1") '指定製品名
d = Worksheets("Sheet2").Range("a65536").End(xlUp).Row
MsgBox d 'Sheet2の最終行
k = 1 'Sheet3の最初行
For i = 1 To d '最終行まで探す
If Worksheets("Sheet2").Cells(i, "A") = x Then
'--Sheet3へ抜き出し
Worksheets("Sheet3").Cells(k, "A") = x
Worksheets("Sheet3").Cells(k, "B") = Worksheets("Sheet2").Cells(i, "B")
k = k + 1 '１行下を指す
End If
Next i
End Sub
ーーー
結果
Ｓｈｅｅｔ３
Ａ１：Ｂ２
製品A 2
製品A 1
ーー
こういうのから初めて、勉強してＦｉｎｄメソッドを使うとかクエリを使うとか進むのだ。
あるいはフィルタの仕組みを使ってでも出来る。
＞データベース（sheet2
エクセルのシートにあるデータぐらいではデータベースとはいえない。用語として大げさすぎる。「データ」でよい。
ｊ

お礼

丁寧にご回答、ありがとうございます。
少しずつ勉強していきたいと思います。
またよろしくお願いします。