Excel教えてください！！

左図のような受注リストがあり、
右図は受注品を作成する為に必要な材料のリストです
（本来はそれぞれ別のファイル上にありますが例として同一ファイルに作成しています）

この2つを元に、「受注商品を作成するために必要な材料の総数」を
知りたいのですが、関数ではどうにもならず
マクロは記録マクロ程度にしか使えない為困っています

どなたかご教授ください

質問者からの補足コメント

• 見てくださってありがとうございます！
  
  全体でじゃがいもが何個必要なのか、人参が何個必要なのか、がわかればOKです
  一旦受注番号ごとの個数を出して全体を足す形が簡単なら勿論それでも大丈夫です！

  No.1の回答に寄せられた補足コメントです。 補足日時：2019/10/23 06:30

• 見てくださってありがとうございます！
  
  「発注リスト」は別シートが希望です
  結果の図はまだ運用に至っていない為（当方が手詰まりで）存在しないので形は特にありません
  目的は「全体で各材料は何個必要なのか？」なので
  それがわかれば発注リストはどんな形でも大丈夫です

  No.2の回答に寄せられた補足コメントです。 補足日時：2019/10/23 06:34

• まとめて補足すれば良かったんですね…不馴れですみません
  
  製造関係なのはそうなのですが、決まったフォーマットやプログラムなんて立派なものはありませんのでこのまま見ていただければ大丈夫です
  
  受注リストの処理ですが
  本来は数量よりも右に品番や納期の列が続いていて確かH列くらいに『未処理、発注済、納品済』みたいなステータスをいれたい列があったと思います（自宅からのため正確な列がわからずすみません）
  なので発注リストに出力した分は『未処理』から『発注済』になるようになると嬉しいです

    補足日時：2019/10/23 06:48

• 

  お二方ありがとうございます。
  
  残念ながら私の力不足でワークシート名の書き換えが間違っているのかどちらもうまく動かず。。。
  本来のもっとごちゃごちゃしたデータを例に示した形になるべく近づけたのですが何がいけないのか。。。
  
  もう少し頑張ってみます。

    補足日時：2019/10/24 13:05

• tom04様
  ご教授ありがとうございます！
  例に提示しました分同じように動きました！
  
  実ファイルに転載してみたところ28行目で
  
  .Cells(c.Row, myCol) = .Cells(c.Row, "B") * wS2.Cells(i, "C")
  
  となってしまいます。
  知識不足で申し訳ありませんが何が原因かわかりますでしょうか。。。

  No.4の回答に寄せられた補足コメントです。 補足日時：2019/10/24 16:03

No.1 回答者： めぐみん_ 回答日時： 2019/10/22 20:26

結果としてはどのような表示を希望されているのでしょう？

・ハンバーグ１１個分の材料別必要個数
・ハンバーグ受注番号毎の材料別必要個数
でも書き方は変わると思います。

No.2 回答者： GooUserラック 回答日時： 2019/10/22 20:34

「材料リスト」と「受注リスト」から「発注リスト」を作成するわけですね？

それぞれのファイル名とシート名を教えて下さい。
①「発注リスト」は全てまとめた方がよいのでしょうか？
②「発注リスト」は別シートに作成すればよいのでしょうか？
出来れば結果の図も提示してくれると判りやすいです。

No.3 回答者： GooUserラック 回答日時： 2019/10/22 21:41

もしかしたらですが「受注番号」の頭６桁（日付）ごとのリストを作れば良いのでしょうか？

No.4 回答者： tom04 回答日時： 2019/10/22 21:52

こんばんは！

お示しの画像通りだとして・・・
「材料」シートは「受注リスト」シートの商品１つに対して必要とする量だと解釈しました。
すなわち、肉じゃが１商品に対してじゃがいも→3　人参→2・・・
といった感じです。

別シートに表にしてまとめてはどうでしょうか？
↓の画像のようにSheet3にまとめるようにしてみました。
標準モジュールです。

Sub Sample1()
　Dim i As Long, j As Long
　Dim lastRow As Long, myCol As Long
　Dim wS1 As Worksheet, wS2 As Worksheet
　Dim c As Range, r As Range

　　Set wS1 = Worksheets("受注リスト")
　　Set wS2 = Worksheets("材料")
　　　Application.ScreenUpdating = False
　　　　With Worksheets("Sheet3")
　　　　　.Cells.Clear
　　　　　wS1.Range("B:B").AdvancedFilter Action:=xlFilterCopy, copytorange:=.Range("A1"), unique:=True
　　　　　.Range("B1") = "数量"
　　　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　　With Range(.Cells(2, "B"), .Cells(lastRow, "B"))
　　　　　　　　.Formula = "=SUMIF(受注リスト!B:B,A2,受注リスト!C:C)"
　　　　　　　　.Value = .Value
　　　　　　　End With
　　　　　　　　For i = 1 To wS2.Cells(Rows.Count, "B").End(xlUp).Row
　　　　　　　　　Set c = .Range("A:A").Find(what:=wS2.Cells(i, "A"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　　Set r = .Rows(1).Find(what:=wS2.Cells(i, "B"), LookIn:=xlValues, lookat:=xlWhole)
　　　　　　　　　　If r Is Nothing Then
　　　　　　　　　　　myCol = .Cells(1, Columns.Count).End(xlToLeft).Column + 1
　　　　　　　　　　　.Cells(1, myCol) = wS2.Cells(i, "B")
　　　　　　　　　　Else
　　　　　　　　　　　myCol = r.Column
　　　　　　　　　　End If
　　　　　　　　　　　.Cells(c.Row, myCol) = .Cells(c.Row, "B") * wS2.Cells(i, "C")
　　　　　　　　Next i
　　　　　　　　　lastRow = .Cells(Rows.Count, "A").End(xlUp).Row
　　　　　　　　　.Cells(lastRow + 1, "A") = "合計"
　　　　　　　　　　For j = 3 To .Cells(1, Columns.Count).End(xlToLeft).Column
　　　　　　　　　　　.Cells(lastRow + 1, j) = WorksheetFunction.Sum(Range(.Cells(2, j), .Cells(lastRow, j)))
　　　　　　　　　　Next j
　　　　　　　　　　.Range("A:A").HorizontalAlignment = xlCenter
　　　　　　　　　　.Rows(1).HorizontalAlignment = xlCenter
　　　　　　　　　.Columns.AutoFit
　　　　　　　　　.Range("A1").CurrentRegion.Borders.LineStyle = xlContinuous
　　　　　　　　　.Activate
　　　　End With
　　　Application.ScreenUpdating = True
　　　　MsgBox "完了"
End Sub

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

No.5 回答者： GooUserラック 回答日時： 2019/10/22 21:58

因みに「材料リスト」と「受注リスト」は何行位ありますか？

No.6 回答者： めぐみん_ 回答日時： 2019/10/22 22:33

もしかしてですけど。

これって工業製品を作成する際の製造仕様書に振り分ける（ロット毎）ための物ではないですよね？
実際はそれを記載（代入）するフォーマットが既に存在しているとか？
製造部隊とか倉庫作業員に配布するためのもの？

No.7 回答者： GooUserラック 回答日時： 2019/10/23 06:25

「受注リスト」シートですが次のどれが良いですか？

① Ｄ列に「出力」みたいな項目を作り「発注リスト」に出力した行に「済」を入れていく
②「発注リスト」に出力した行はクリアする。
③ その他 ⇒ 「発注リスト」に出力した後の処理を詳しく説明して下さい

No.8 回答者： GooUserラック 回答日時： 2019/10/23 06:42

発注リストは図のようにされると事前に印刷用のレイアウトが組めて便利だと思います。

いかがでしょうか？

No.9 回答者： めぐみん_ 回答日時： 2019/10/23 14:27

一例です。

多分鈍行です。

Sub megu()
Dim myDic1 As Object, myDic2 As Object
Dim r As Range, v

Set myDic1 = CreateObject("Scripting.Dictionary")
Set myDic2 = CreateObject("Scripting.Dictionary")

With Worksheets("受注リスト")
For Each r In .Range(.[B2], .Cells(Rows.Count, 2).End(xlUp))
If .Cells(r.Row, "H").Value = "未処理" Then '多分Ｈ列？違ったら名称変更願います。
If Not myDic1.Exists(r.Value) Then
myDic1.Add r.Value, r.Offset(, 1).Value
Else
myDic1(r.Value) = Val(myDic1(r.Value)) + r.Offset(, 1).Value
End If
'.Cells(r.Row, "H").Value = "発注済" '仕様の際はコメントアウトを外して（一番左の）下さい。
End If
Next
End With

With Worksheets("材料")
For Each r In .Range(.[B1], .Cells(Rows.Count, 2).End(xlUp))
If Not myDic2.Exists(r.Value) Then
myDic2.Add r.Value, Array(r.Value, r.Offset(, 1).Value * Val(myDic1(r.Offset(, -1).Value)))
Else
v = myDic2(r.Value)
v(1) = v(1) + r.Offset(, 1).Value * Val(myDic1(r.Offset(, -1).Value))
myDic2(r.Value) = v
End If
Next
End With

With Worksheets("発注リスト")
.Cells.ClearContents
.Range("A1:B1").Value = Array("材料", "個数")
.Range("A2").Resize(myDic2.Count, 2).Value = Application.Transpose(Application.Transpose(myDic2.Items))
End With

Set myDic1 = Nothing
Set myDic2 = Nothing
End Sub

No.10 回答者： GooUserラック 回答日時： 2019/10/23 15:48

以下の条件で作成してみました

・「発注リスト」と「受注リスト」は同じブックにあり「材料リスト」だけは別ファイルだけど同じフォルダーに存在する。
・「Const　…」の部分の「=」より右は、状況に応じて変更して下さい。
・「発注リスト」シートのレイアウトは No.8 の様な物を想定しています。
　　（背景色を１行おきに変えると発注ミスなど減るかもしれません）

Sub 発注リスト作成()

Const 材料リスト名 As String = "材料リスト.xlsx"
Const 受注シート名 As String = "受注リスト"
Const 発注シート名 As String = "発注リスト"
Const ステータス列 As Long = 8
Const 未処理文字 As String = "未処理"
Const 発注済文字 As String = "発注済"
Dim 材料リスト As Variant
Dim 材料終 As Long
Dim 受注行番号 As Long
Dim 食品辞書 As Object
Dim 食品名 As String
Dim 食品数 As Long
Dim 材料辞書 As Object
Dim 材料位置 As Long
Dim 材料名 As String
Dim 材料数 As Long
Dim 辞書位置 As Long
Dim キー() As Variant

　Workbooks.Open Filename:=ThisWorkbook.Path & "\" & 材料リスト名
　Sheets("材料").Select
　材料終 = Cells(Rows.Count, 1).End(xlUp).Row
　材料リスト = Range(Cells(1, 1), Cells(材料終, 3))
　ActiveWindow.Close

　Set 食品辞書 = CreateObject("Scripting.Dictionary")
　Set 材料辞書 = CreateObject("Scripting.Dictionary")
　Sheets(受注シート名).Select
　For 受注行番号 = 2 To Cells(Rows.Count, ステータス列).End(xlUp).Row
　　If Cells(受注行番号, ステータス列).Value = 未処理文字 Then
　　　Cells(受注行番号, ステータス列).Value = 発注済文字
　　　食品名 = Cells(受注行番号, 2).Value
　　　食品数 = Cells(受注行番号, 3).Value
　　　If 食品辞書.exists(食品名) Then
　　　　食品数 = 食品数 + 食品辞書.Item(食品名)
　　　　食品辞書.Remove 食品名
　　　End If
　　　食品辞書.Add 食品名, 食品数
　　　食品数 = Cells(受注行番号, 3).Value
　　　For 材料位置 = 1 To 材料終
　　　　If 材料リスト(材料位置, 1) = 食品名 Then
　　　　　材料名 = 材料リスト(材料位置, 2)
　　　　　材料数 = 材料リスト(材料位置, 3) * 食品数
　　　　　If 材料辞書.exists(材料名) Then
　　　　　　材料数 = 材料数 + 材料辞書.Item(材料名)
　　　　　　材料辞書.Remove 材料名
　　　　　End If
　　　　　材料辞書.Add 材料名, 材料数
　　　　End If
　　　Next
　　End If
　Next
　Sheets(発注シート名).Select
　Range(Cells(2, 1), Cells(Rows.Count, 5)).ClearContents
　キー = 食品辞書.keys
　Do Until 辞書位置 = 食品辞書.Count
　　Cells(辞書位置 + 2, 1).Value = キー(辞書位置)
　　Cells(辞書位置 + 2, 2).Value = 食品辞書.Item(キー(辞書位置))
　　辞書位置 = 辞書位置 + 1
　Loop
　辞書位置 = 0
　キー = 材料辞書.keys
　Do Until 辞書位置 = 材料辞書.Count
　　Cells(辞書位置 + 2, 4).Value = キー(辞書位置)
　　Cells(辞書位置 + 2, 5).Value = 材料辞書.Item(キー(辞書位置))
　　辞書位置 = 辞書位置 + 1
　Loop
　Set 食品辞書 = Nothing
　Set 材料辞書 = Nothing
　　
End Sub

※ 材料リストは「材料リスト」という配列に一気に代入、商品や材料の処理は辞書上で行って、最後に結果をシートに代入しているので、かなり高速で処理されていると思います。（少ないデータでは変りません）
※ 多分問題ないと思いますが、発注リストの順番は元の順番とは関係なくなっています。