エクセルマクロで納品書の内容を在庫管理表に転記(値の貼り付け)方法がわかりません。

エクセルマクロを最近始めた初心者です。
皆様のお力添えをお願い致します。

会社の作業効率化のため少しづつ、マクロを作成しているのですが、とうとう行き詰ってしまい質問させていただきました。

・行いたい事
下記にありますシート2の納品した商品のID、このIDと同じIDをシート1で検索し金額の部分をそれぞれ埋めたいです。


シート1(在庫管理表)

　　　A　　　　　　　B　　　　　　　C
1　　ID　　　　　　商品　　　　　　金額

2　　A448　　　　Aカード

3　　A497　　　　Bカード

4　　A348　　　　Cカード

5　　A123　　　　Dカード

6　　A228　　　　Eカード

7　　A978　　　　Fカード

8　　A214　　　　Gカード

9　　A369　　　　Hカード



シート2(納品書)

　　　A　　　　　　　B　　　　　　　C
1　　ID　　　　　　商品　　　　　　金額

2　　A448　　　　Aカード　　　　　 260

3　　A348　　　　Cカード　　　　　 680

4　　A228　　　　Eカード　　　　　 210

5　　A369　　　　Hカード　　　　　2480


↓結果
シート1(在庫管理表)
　　　A　　　　　　　B　　　　　　　C
1　　ID　　　　　　商品　　　　　　金額

2　　A448　　　　Aカード　　　　　　260

3　　A497　　　　Bカード

4　　A348　　　　Cカード　　　　　　680

5　　A123　　　　Dカード

6　　A228　　　　Eカード　　　　　　210

7　　A978　　　　Fカード

8　　A214　　　　Gカード

9　　A369　　　　Hカード　　　　　2480


お力添えよろしくお願いします。

※「Dictionary」などできそうなものは、調べてはみたものの、実践で活用するまでの知識がまだありません。

No.2 ベストアンサー 回答者： tom04 回答日時： 2018/08/18 23:57

こんばんは！

関数で簡単にできそうですが・・・
Sheet1のC2セルに
=IF(COUNTIFS(Sheet2!A:A,A2,Sheet2!B:B,B2),SUMIFS(Sheet2!C:C,Sheet2!A:A,A2,Sheet2!B:B,B2),"")

として、下へずぃ～～～！っとフィル＆コピー！

どうしてもVBAでやりたい！という場合は
一例です。
標準モジュールにしてください。

Sub Sample1()
　Dim myDic As Object
　Dim i As Long, lastRow As Long, lastRow2 As Long
　Dim myStr As String, wS As Worksheet
　Dim myKey, myItem, myR1, myR2, myAry
　　Set myDic = CreateObject("Scripting.Dictionary")
　　Set wS = Worksheets("Sheet2")
　　　With Worksheets("Sheet1")
　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　Range(.Cells(2, "C"), .Cells(lastRow, "C")).ClearContents
　　　　myR1 = Range(.Cells(2, "A"), .Cells(lastRow, "C"))
　　　　　For i = 1 To UBound(myR1, 1)
　　　　　　myStr = myR1(i, 1) & "_" & myR1(i, 2)
　　　　　　myDic.Add myStr, myR1(i, 3)
　　　　　Next i
　　　　lastRow2 = wS.Cells(Rows.Count, "A").End(xlUp).Row
　　　　myR2 = Range(wS.Cells(2, "A"), wS.Cells(lastRow2, "C"))
　　　　　For i = 1 To UBound(myR2, 1)
　　　　　　myStr = myR2(i, 1) & "_" & myR2(i, 2)
　　　　　　　If myDic.exists(myStr) Then
　　　　　　　　myDic(myStr) = myDic(myStr) + myR2(i, 3)
　　　　　　　End If
　　　　　Next i
　　　　myKey = myDic.keys
　　　　myItem = myDic.items
　　　　　For i = 0 To UBound(myKey)
　　　　　　myAry = Split(myKey(i), "_")
　　　　　　　myR1(i + 1, 1) = myAry(0)
　　　　　　　myR1(i + 1, 2) = myAry(1)
　　　　　　　myR1(i + 1, 3) = myItem(i)
　　　　　Next i
　　　　Range(.Cells(2, "A"), .Cells(lastRow, "C")) = myR1
　　　　Set myDic = Nothing
　　　End With
　　MsgBox "完了"
End Sub

※　コード内のシート名は実際のシート名にしてください。

※　コードは長いですが、
両シートとも数万行あっても数秒で終わると思います。m(_ _)m

この回答へのお礼

ご回答いただきありがとうございました。

同時に納品書の印刷もしたい為、マクロで作った方がいいかと思っておりました。
※納品書(シート2)は印刷後項目は空にしたいので、
IFやVlookUP関数ですと自分の知る限りでは、参照値がなくなると0表記となると思っておりましたので、マクロで考えておりました。

上記で頂きましたコードで値の貼り付けができておりましたので、大変助かりました。

ありがとうございました。

お礼日時：2018/08/19 00:19

No.1 回答者： mabuterol 回答日時： 2018/08/18 23:11

これ excel の vlookup 関数でもいけるんですが、マクロを使いたいんですか？

1. シート 1 から、i 行目の id を文字列として抽出
2. その文字列をシート 2 で検索し、ヒットしたセル位置を、long 型で記録
3. そのセルから２個右にいったセルの金額を long ないし currency 型で記録
4. 記録した数字を、シート 1 の i 行目の所定の位置に書き込む

このステップでマクロ化できますが、どこでダメですか？

この回答へのお礼

ご回答いただきありがとうございます。

＞これ excel の vlookup 関数でもいけるんですが、マクロを使いたいんですか？

同時に納品書の印刷もしたい為、マクロで作った方がいいかと思っておりました。
※納品書(シート2)は印刷後項目は空にしたいので、VlookUP関数では難しい(参照先がなくなる？)気がしておりましたが可能なのでしょうか？


＞このステップでマクロ化できますが、どこでダメですか？
「2.」の部分シート2で検索の方法がよくわかりません。
調べた際に下記のようなものも見たのですが、その後どのようにするのかわかりませんでした。

　 Dim myCnt As Long
Dim myVal As Variant
Dim r As Range

お礼日時：2018/08/18 23:30