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.28 回答者： めぐみん_ 回答日時： 2019/10/31 10:14

追加になりますが（回答ではなく）。

最終の返信日が2019/10/24。
東日本はその翌日雨（地域により大雨）がありました。

可能性として考えたくはないですが、被災した地域からのアクセスをされてたためそれが出来なくなったとも言えるんじゃないでしょうか？
もし自宅が被災してたらここへ書き込みをしている余裕はないと思いますし。
仮に時間切れで閉じられたとしても、再度質問が立った時に協力をされたら宜しいのではないかと。

No.27 回答者： めぐみん_ 回答日時： 2019/10/31 06:59

回答ではなくすいません。

必要なくなったと言う事ではないでしょうと私は思います。
ただ唯一動いたコード作成者のtom04さんから返信がないためか、或いは社内的に急ぐ事になり業務委託になった可能性を感じます。

私がDictionaryが使えないって言うのも、実際PCがMACだったり？と言う疑念を持っただけの事で正解・不正解は不明ですね。
ただMACであると仮定すればDictionaryを使わないだけではコードは正常に動かないですよ。
例えばWinのパスの区切りは"\"ですが、MACでは"/"ですしね。
MACに触れた事はないので他に何があるかはググって行くのもしんどいのでやめました。

そう言った点から移植を頼んでいる最中かMACの回答が付きやすいサイトに移行したかではないでしょうか？
または元々のデータのあり方を見直し修正を社内で検討しているか、作成担当を変更されてしまったなどあるのかも。

私も１週間でVBA未経験からデータベースを作れと言われ、GWすべて潰しましたし。（DAOでmdbに接続しデータの抽出条件はユーザーフォーム使用で抽出結果はシート上）
手に入れた参考書とググって調べて９割超の完成品でGW明けに社長に見せたことあります。

No.26 回答者： GooUserラック 回答日時： 2019/10/29 15:33

一応確認ですが、もう必要では無くなったのでしょうか？

まだ必要ならばいろいろ考えたいのです。こちらで想定している物では気づいている限り動いている物を提示しています。実働の環境で動かないならばその違いが判らないと修正出来ません。まだ必要でしたら皆さんから出ている疑問に対してお答えいただかないと先に進まないと思います。
もう必要ないならば、不要な事を言っていただいた方が良いと思います。よろしくお願い致します。

No.25 回答者： GooUserラック 回答日時： 2019/10/28 22:53

No.24 の補足

内容にもよりますが、材料のデータ５万件、受注リストの件数３００件で３０秒位かかりました。件数が増えると比較する値も増えるので４００件だと１分位になります。止まっているように見えてしまうのでステータスバーに処理件数を表示するようにしています。

No.24 回答者： GooUserラック 回答日時： 2019/10/28 22:43

No.19 で めぐみん_さんが「Dictionaryオブジェクト」が使えないのではという事が有りましたので使わないバージョンを作ってみました。

まだ最適か出来ますがとりあえず使えるかお試しください。

Sub 発注リスト作成()

Const 材料シート名 As String = "材料"
Const 受注シート名 As String = "受注品リスト"
Const 発注シート名 As String = "発注品リスト"
　
Dim 材 As Variant
Dim 材終 As Long
Dim 受 As Variant
Dim 終 As Long
Dim 受終 As Long
　
　Sheets(発注シート名).Select
　Range(Cells(4, 2), Cells(Rows.Count, 3)).ClearContents
　Range(Cells(3, 5), Cells(Rows.Count, 5)).ClearContents
　Range(Cells(2, 7), Cells(Rows.Count, 11)).ClearContents
　
　Workbooks.Open Filename:=ThisWorkbook.Path & "\材料ファイル.xlsx"
　Sheets(材料シート名).Move Before:=ThisWorkbook.Sheets(1)
　Cells.Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlYes
　材終 = Cells(Rows.Count, 1).End(xlUp).Row
　材 = Range(Cells(1, 1), Cells(材終, 3))
　Application.DisplayAlerts = False
　ActiveSheet.Delete
　Application.DisplayAlerts = True
　
　Workbooks.Open Filename:=ThisWorkbook.Path & "\受注ファイル.xlsx"
　Sheets(受注シート名).Move Before:=ThisWorkbook.Sheets(1)
　Cells.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlYes
　受終 = Cells(Rows.Count, 2).End(xlUp).Row
　Range(Cells(2, 4), Cells(受終, 5)).ClearContents
　If 受終 < 材終 Then
　　Range(Cells(受終 + 1, 2), Cells(材終, 5)).ClearContents
　　終 = 材終
　Else
　　終 = 受終
　End If
　受 = Range(Cells(2, 2), Cells(終, 6)) ' ｢材料｣｢個数｣｢未登録料理｣用に横に３つ増やしてある
　受終 = 受終 - 1 ' ２行目から取り込んでいるので１を引いている
　Application.DisplayAlerts = False
　ActiveSheet.Delete
　Application.DisplayAlerts = True
　
Dim 材位置 As Long
Dim 受位置 As Long
Dim 発位置 As Long
Dim 未位置 As Long
Dim 発有 As Boolean
Dim 発終 As Long
Dim 未無 As Boolean
Dim 未終 As Long
　
　For 受位置 = 1 To 受終
　　Application.StatusBar = 受位置 & " / " & 受終
　　DoEvents
　　未無 = False
　　For 材位置 = 1 To 材終
　　　If 受(受位置, 1) = 材(材位置, 1) Then
　　　　未無 = True
　　　　発有 = False
　　　　For 発位置 = 1 To 発終
　　　　　If 受(発位置, 3) = 材(材位置, 1) Then
　　　　　　発有 = True
　　　　　　受(発位置, 4) = 受(発位置, 4) + 受(受位置, 2) * 材(材位置, 3)
　　　　　　Exit For
　　　　　End If
　　　　Next
　　　　If 発有 = False Then
　　　　　発終 = 発終 + 1
　　　　　受(発位置, 3) = 材(材位置, 2)
　　　　　受(発位置, 4) = 受(受位置, 2) * 材(材位置, 3)
　　　　End If
　　　End If
　　Next
　　If 未無 = False Then
　　　For 未位置 = 1 To 未終
　　　　If 受(未位置, 5) = 受(受位置, 1) Then
　　　　　未無 = True
　　　　　Exit For
　　　　End If
　　　Next
　　　If 未無 = False Then
　　　　未終 = 未終 + 1
　　　　受(未位置, 5) = 受(受位置, 1)
　　　End If
　　End If
　Next
　Range(Cells(2, 7), Cells(終, 11)) = 受
　Application.StatusBar = False
　
　終 = Cells(Rows.Count, 9).End(xlUp).Row
　Range(Cells(2, 9), Cells(終, 10)).Copy
　Range("B4").PasteSpecial xlPasteValues
　終 = Cells(Rows.Count, 11).End(xlUp).Row
　If 終 > 1 Then
　　Range(Cells(2, 11), Cells(終, 11)).Copy
　　Range("E4").PasteSpecial xlPasteValues
　　With Range("E3")
　　　.Value = "（登録後要再実行）"
　　　.Font.Color = RGB(255, 0, 0)
　　　.HorizontalAlignment = xlCenter
　　End With
　End If
　Application.CutCopyMode = False
　Range(Cells(2, 7), Cells(Rows.Count, 11)).ClearContents

End Sub

もし動かなければ、以下の条件や修正を行ってください。

ⓐ 発注リストのあるファイルにマクロのコードが書かれている。
ⓑ 材料のファイルが「材料ファイル.xlsx」ではないときは「材料ファイル.xlsx」を実際のファイル名にして下さい。なお拡張子が「xls」または「xlsx」でないときはこのままでは動きません、必ずご連絡下さい。
ⓒ 受注リストのファイルが「受注ファイル.xlsx」ではないときは「受注ファイル.xlsx」を実際のファイル名にして下さい。なお拡張子が「xls」または「xlsx」でないときはこのままでは動きません、必ずご連絡下さい。
ⓓ 発注リストと受注リストのファイルが別フォルダにある時は「ThisWorkbook.Path & "\受注ファイル.xls"」を絶対パスに書き換えて下さい。
ⓔ 発注リストと材料が同じファイルにある場合は「Workbooks.Open Filename:=ThisWorkbook.Path & "\材料ファイル.xls"」をコメントアウトするなりして無効にして下さい。
ⓕ 発注リストと受注リストが同じファイルにある場合は「Workbooks.Open Filename:=ThisWorkbook.Path & "\受注ファイル.xls"」をコメントアウトするなりして無効にして下さい。
ⓖ 材料はタイトル行が無く１行目からデータが有る。（位置関係が違う場合は修正が必要です）
ⓗ 受注リストはタイトル行が有り２行目からデータが有る。（位置関係が違う場合は修正が必要です）
ⓘ 想定した発注リストは図のようなイメージです。（位置関係が違う場合は修正が必要です）
ⓙ 作業エリアは実行後クリアされます。場所は変更しても構いませんが５列分確保して下さい。
ⓚ 未登録の料理が発注リストに有った場合は、未登録の料理名が表示されるとともに E3セルに「（登録後要再実行）」の文字が赤字で表示されます。発注一覧に載りませんので登録後、初めからやり直して下さい。

上記の事が自力修正出来ないなら、どこが出来ないかと No.16 の対して返答ください。修正して再度アップします。

No.23 回答者： めぐみん_ 回答日時： 2019/10/28 21:38

個人的には。

商品・材料・個数

において実際には、

商品・材料・個数
ああ・材A・３

があるとした時、この材Aを作るためのサブ材料群が存在しているんじゃないですか？
例題を『料理』とした事が質問者さんとしてはわかりやすいと思ったのかもですが、実際の管理部分とはマッチング出来なかったとか。

商品・材料・個数
ああ・材A・３
材A・材ａ・２
材A・材ｃ・２

みたいな感じのもの。
例題としてあげるなら車とかそう言った『ユニット』で製造管理するような物を挙げたほうが良かったのかもと感じます。（あくまで憶測です）

No.22 回答者： GooUserラック 回答日時： 2019/10/28 12:55

No.16 に対して実際の名前がなどが示す事が出来なければ、どこが変更されたか判るようなものを提示されて、ご自分でそこを実際の物に修正されると良いと思います。

例①、実際のファイル名「㈱ファフェコビ会社仕入れ.xlsx」ならば「①.xlsx」などにすれば良いと思います。（注：拡張子は変えないで下さい。他と重複しないものを選んでください）
例②、実際のパスが「C:\Users\fafekobi\ファフェコビ会社\仕入れ.xlsx」ならば「C:\Users\AAAA\BBBB\CCCC.xlsx」にする。（注：階層数は変えないで下さい。他との関係が判るようにもして下さい）

No.21 回答者： bonaron 回答日時： 2019/10/27 15:40

他のファイルというこで

パワークエリという手もありますよ。

パワークエリを初めて使ってみた話【データの取得】
https://sakatakablog.com/excel/253/

初めてつかってみましたが
１時間ちょっとで No.11 さんの結果が得られました。
Access をやっているのでイメージが掴みやすいということもありますが。

VBA よりは習得しやすく、Excel で難しかったことが簡単にできます。

No.20 回答者： めぐみん_ 回答日時： 2019/10/25 21:24

また直接の回答ではないですが。

tom04さんのコードで質問内容では問題なく動きました。
ただ実際のファイルでは動きません（？）でした。
何が原因ですか？

これでは回答者はわかりませんよ。
まず実際のファイルを見ることが出来ないのはわかりますよね？
それでコードの一部を載せて『原因は？』と問われてもそこで何が起きているのかエラー情報などもない訳ですし、何よりエラー発生時のデバッグ処理について調べなきゃ。
少なくともその一文でエラー表示されているのなら、『c.Row, myCol, c.Row, i』などにカーソルを持っていき該当セルが質問内容とどう違うのか、その情報も必要でしょう。
実際のファイルを伏せるのですからその他の情報は出し惜しみされてもって思いますよ。

No.19 回答者： めぐみん_ 回答日時： 2019/10/25 06:21

直接の回答ではないですが。

何か補足質問が多いみたいなので。

＞tom04様
＞ご教授ありがとうございます！<br />
＞例に提示しました分同じように動きました！

と連絡があるのですから、まずはそちらのコードを読み解くことが大事なんじゃない？
そして何故二人のコードがダメなのかについては憶測ですけど、その違いは『純粋にExcelVBAだけを用いている』のと『Windows機能のDictionaryオブジェクトを呼び出している』
点から、『使用されているPCのOSがWindowsではない』とも思えます。

なのでtom04さんのコードを読み解き（データ一などに問題無しとして）Dictionaryを用いずにコーティングする事ではないのかなって思えます。
少なくともヒントになる内容は詰まっているのですから、まずはそちらを参考にデータ配置をされて対処するのも回答者としての勉強になりますよ。