Excel で、二つの表の値が条件に合致したらセル値を別表に転記のVBAコードを教えて下さい

Excel　シート内で、データー表と基本データー表とがあり、条件に合致するセルの値をデーター表からコピーして、基本データ表に貼り付けたいのですが、VBAコードが分かりませんどうか教えてください。

＜詳細＞

各データー表は、sheet名がデーターリストにあります。
データー表は、A列が製品名、B列が数量
基本データー表は、Ｄ列が部品番号、E列が製品名、F列が数量となっいます。

データー表のA列製品名と、基本データー表のE列の製品名と合致したら、F列の数量へ
データー表のB列数量のデーターを基本データー表のF列の数量へ転記する。

※データー表の行数はその都度変動します。

※基本データー表の行数は１００あります。

※添付画像を参照願います。

説明が下手ですみません
お分かりになる方、ご教授のほどよろしくお願いします。

No.1 ベストアンサー 回答者： GooUserラック 回答日時： 2020/01/20 04:25

以下のような物はいかがでしょうか？

※ A列に有ってE列に無い物は何もしません。
※ A列に重複するものが有った場合加算されます。
　（F列は事前にクリアしないといけないかもしれません。）
※ E列に重複するものが有った場合は上の物しか反映しません。

Sub Sample()
Dim 先行番号 As Long
Dim 元行番号 As Long
Dim 製品名辞書 As Object
　Set 製品名辞書 = CreateObject("Scripting.Dictionary")
　For 先行番号 = 2 To Cells(Rows.Count, 5).End(xlUp).Row
　　If 製品名辞書.Exists(Cells(先行番号, 5).Value) = False Then
　　　製品名辞書.Add Cells(先行番号, 5).Value, 先行番号
　　End If
　Next
　For 元行番号 = 2 To Cells(Rows.Count, 1).End(xlUp).Row
　　If 製品名辞書.Exists(Cells(元行番号, 1).Value) Then
　　　先行番号 = 製品名辞書.Item(Cells(元行番号, 1).Value)
　　　Cells(先行番号, 6).Value = Cells(先行番号, 6).Value + Cells(元行番号, 2).Value
　　End If
　Next
　MsgBox ("終了しました")
End Sub

この回答へのお礼

早々の対応ありがとうございました。
本当に助かります。
今後、今回の基本データー表を使って、別ブックにデーター
を転記させたいと思っています。

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

お礼日時：2020/01/20 06:44