プロが教えるわが家の防犯対策術!

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

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

どなたかご教授ください

「Excel教えてください!!」の質問画像

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

  • 見てくださってありがとうございます!

    全体でじゃがいもが何個必要なのか、人参が何個必要なのか、がわかれば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

A 回答 (28件中11~20件)

No.16 の補足



「⑦「商品」「数量」の下には何かありますか?あるなら何行目から始まっていますか?」ですが有りがちなのが「合計」などです。
    • good
    • 0

No.16 の補足



「① ファイル名は何ですか?」ですが、それぞれの関係が判るように出来ればフルパスでお願い致します。
    • good
    • 0

次のいくつかをご提示いただければ問題点と対策が可能かもしれません。


いづれも実データでお願いします

☆ 共通事項(「材料」「受注リスト」「発注リスト」それぞれ3つともお答えください)
① ファイル名は何ですか?
② シート名は何ですか?

☆ 材料について
③「商品」「材料」「数量」の列名はそれぞれ何ですか?
④「商品」「材料」「数量」はそれぞれ何行目から始まっていますか?

☆ 受注リストについて
⑤「商品」「数量」の列名はそれぞれ何ですか?
⑥「商品」「数量」はそれぞれ何行目から始まっていますか?
⑦「商品」「数量」の下には何かありますか?あるなら何行目から始まっていますか?

☆ 受注リストについて
⑧「材料」「数量」の列名はそれぞれ何ですか?
⑨「材料」「数量」はそれぞれ何行目から始めますか?

☆ その他
⑩ このマクロのコードはどのファイルに置いていますか?
    • good
    • 0

もしかしてお持ちのPCはMACだったり?

    • good
    • 0

個人的にはダミーにしたとしても、実際のデータがどんな風になっているのかが気になりますね。


今回は2段階で求めるものでした(?)けど、以前多段階で求めるようなものもありましたし。
例えばフォルダ内のサブフォルダの階層が一定ではない場合とか。
    • good
    • 0

もしも 実行してエラーが出たならばその内容とどこの行で発生したかで問題点が判るかもしれません。

    • good
    • 0

ISOの文書みたいに関連事項が複雑になってるのかな?



実際質問で挙げてる内容で実行したらどうなのかと、気にはなりましたけど
    • good
    • 0

No.9です。



最終的に画像のようになれば良かったのかと思ったのですが・・・違いましたかね?
手始めってことで1つのBook内に全てのシートがある事を想定してます。
「Excel教えてください!!」の回答画像11
    • good
    • 0

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



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

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

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

一例です。


多分鈍行です。

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 '多分H列?違ったら名称変更願います。
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
    • good
    • 0

お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!