こんにちはゲストさん。会員登録(無料)して質問・回答してみよう!

解決済みの質問

エクセル VBA 初心者で困っております!

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



その後、セルB1(sheet1)に入力した値と貼り付けた別のシート(sheet3)で数値1×数値2(B1で入力した値)を掛け算し、数値3に出すのが目的です。

sheet1

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


sheet2(データベース)

  
  製品名      数値1    数値2   数値3

1 製品C       2          
2 製品A       2
3 製品A       1
4 製品B       4
5 製品D       3
6 製品D       5

sheet3(貼付先)

実行結果

  製品名      数値1    数値2   数値3        
1 製品A       2        5     10
2 製品A       1        5      5


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

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

投稿日時 - 2011-12-20 00:38:27

QNo.7199479

すぐに回答ほしいです

質問者が選んだベストアンサー

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

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")

’シート3のC列D列に必要な記入を行う(記録マクロと同じ)
 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

投稿日時 - 2011-12-20 01:34:44

お礼

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

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

投稿日時 - 2011-12-21 06:24:58

ANo.1

このQ&Aは役に立ちましたか?

0人が「このQ&Aが役に立った」と投票しています

回答(3)

ANo.3

こんばんは!
すでに回答は出ていますので、参考程度で・・・
オートフィルタではなく、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

投稿日時 - 2011-12-20 21:59:04

お礼

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

投稿日時 - 2011-12-21 06:29:40

ANo.2

初心者がリストボックスを・・など難しいことを考えすぎ。
丸投げで、時間が゛無いなんて言っているが、自分で少しづつやるべき。
解答を人にたよりすぎ。
それまでは手作業(検索やフィルタ・コピー)でやること。
マクロの記録でも取れば、修正箇所の質問だけになるだろう。それさえも気がついてないのでっは。
もっと初心者は初心者らしい仕組みとプログラムで動かすべきだろう。
例データ
Sheet1
A1に製品名 
製品A
を入力
コマンドボタンを1つ貼り付け。
ーー
Sheet2A1:B6
製品C2
製品A2
製品A1
製品B4
製品D3
製品D5
ーー
コード
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 '1行下を指す
End If
Next i
End Sub
ーーー
結果
Sheet3
A1:B2
製品A2
製品A1
ーー
こういうのから初めて、勉強してFindメソッドを使うとかクエリを使うとか進むのだ。
あるいはフィルタの仕組みを使ってでも出来る。
>データベース(sheet2
エクセルのシートにあるデータぐらいではデータベースとはいえない。用語として大げさすぎる。「データ」でよい。

投稿日時 - 2011-12-20 09:28:13

お礼

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

投稿日時 - 2011-12-21 06:27:24

あなたにオススメの質問