A 回答 (28件中11~20件)
- 最新から表示
- 回答順に表示
No.16
- 回答日時:
次のいくつかをご提示いただければ問題点と対策が可能かもしれません。
いづれも実データでお願いします
☆ 共通事項(「材料」「受注リスト」「発注リスト」それぞれ3つともお答えください)
① ファイル名は何ですか?
② シート名は何ですか?
☆ 材料について
③「商品」「材料」「数量」の列名はそれぞれ何ですか?
④「商品」「材料」「数量」はそれぞれ何行目から始まっていますか?
☆ 受注リストについて
⑤「商品」「数量」の列名はそれぞれ何ですか?
⑥「商品」「数量」はそれぞれ何行目から始まっていますか?
⑦「商品」「数量」の下には何かありますか?あるなら何行目から始まっていますか?
☆ 受注リストについて
⑧「材料」「数量」の列名はそれぞれ何ですか?
⑨「材料」「数量」はそれぞれ何行目から始めますか?
☆ その他
⑩ このマクロのコードはどのファイルに置いていますか?
No.14
- 回答日時:
個人的にはダミーにしたとしても、実際のデータがどんな風になっているのかが気になりますね。
今回は2段階で求めるものでした(?)けど、以前多段階で求めるようなものもありましたし。
例えばフォルダ内のサブフォルダの階層が一定ではない場合とか。
No.11
- 回答日時:
No.9です。
最終的に画像のようになれば良かったのかと思ったのですが・・・違いましたかね?
手始めってことで1つのBook内に全てのシートがある事を想定してます。
No.10
- 回答日時:
以下の条件で作成してみました
・「発注リスト」と「受注リスト」は同じブックにあり「材料リスト」だけは別ファイルだけど同じフォルダーに存在する。
・「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
※ 材料リストは「材料リスト」という配列に一気に代入、商品や材料の処理は辞書上で行って、最後に結果をシートに代入しているので、かなり高速で処理されていると思います。(少ないデータでは変りません)
※ 多分問題ないと思いますが、発注リストの順番は元の順番とは関係なくなっています。
No.9
- 回答日時:
一例です。
多分鈍行です。
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
お探しのQ&Aが見つからない時は、教えて!gooで質問しましょう!
似たような質問が見つかりました
- Excel(エクセル) VBA ふたつの同じ様式シートのセルをコピーしたい 2 2023/03/08 15:28
- Excel(エクセル) 【困っています】VBA 追加処理の記述を教えてください。 1 2022/08/25 22:54
- Excel(エクセル) Excel マクロの編集がグレーになって 編集ができなくなりました 2 2023/04/28 20:35
- Excel(エクセル) Excelで全クラスのランキング表を作成したい 4 2022/05/24 15:28
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2022/10/11 12:55
- Excel(エクセル) 記録マクロのみでできますか? 7 2022/08/07 20:38
- Visual Basic(VBA) エクセルのマクロについて教えてください。 4 2023/07/04 17:58
- Visual Basic(VBA) Excel VBA 同じ名前のフォルダがあれば作成したブックを格納するマクロをつくりたい 2 2023/01/16 16:19
- Visual Basic(VBA) エクセルのマクロについて教えてください。 1 2023/07/13 12:31
- Excel(エクセル) Excelのマクロについてご教授ください 2 2023/02/25 09:43
関連するカテゴリからQ&Aを探す
おすすめ情報
デイリーランキングこのカテゴリの人気デイリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
Teraマクロで日付ディレクトリ...
-
excelに貼り付けた数値が勝手に...
-
PDF ファイルが開けません。
-
EXCELのマクロを使って、テキス...
-
EXCELのVBAで画像を選んだ順に...
-
CSVで文字化けしてしまうのを直...
-
エクセル 一括リンクの解除
-
ファイルを並び替えるときの「...
-
EXCELのハイパーリンクの編集を...
-
VLOOKUP関数とネットワークに置...
-
指定のファイルを開くマクロ
-
ローマ字→カタカナへ変換(エク...
-
python fbprophetについて
-
Excelのワークシート上に検索窓...
-
押したボタンの位置取得(共通の...
-
コマンドボタンを押すたびに大...
-
コマンドボタンがあるかどうか...
-
エラーになってないのにVBA...
-
ワードで画像を自動で挿入する方法
マンスリーランキングこのカテゴリの人気マンスリーQ&Aランキング
-
エクセルVBAでセルに入力したパ...
-
excelに貼り付けた数値が勝手に...
-
EXCELのVBAで画像を選んだ順に...
-
Teraマクロで日付ディレクトリ...
-
ファイルを並び替えるときの「...
-
VLOOKUP関数とネットワークに置...
-
エクセル 一括リンクの解除
-
excel INDIRECT 他ファイル参照
-
エクセルファイルから指定した...
-
エディタで効率的な切り出し方法
-
PDF ファイルが開けません。
-
EXCELのマクロを使って、テキス...
-
ハイパーリンクで前回値をひき...
-
エクセルからスキャナVBAで連動...
-
EXCEL VBA ー 同一フォルダ内の...
-
CSVで文字化けしてしまうのを直...
-
エクセルマクロでファイルオー...
-
ミュージックファイルのファイ...
-
エクセルVBAでファイルを連...
-
エクセルVBA+ADOで特定のCSVフ...
おすすめ情報
見てくださってありがとうございます!
全体でじゃがいもが何個必要なのか、人参が何個必要なのか、がわかればOKです
一旦受注番号ごとの個数を出して全体を足す形が簡単なら勿論それでも大丈夫です!
見てくださってありがとうございます!
「発注リスト」は別シートが希望です
結果の図はまだ運用に至っていない為(当方が手詰まりで)存在しないので形は特にありません
目的は「全体で各材料は何個必要なのか?」なので
それがわかれば発注リストはどんな形でも大丈夫です
まとめて補足すれば良かったんですね…不馴れですみません
製造関係なのはそうなのですが、決まったフォーマットやプログラムなんて立派なものはありませんのでこのまま見ていただければ大丈夫です
受注リストの処理ですが
本来は数量よりも右に品番や納期の列が続いていて確かH列くらいに『未処理、発注済、納品済』みたいなステータスをいれたい列があったと思います(自宅からのため正確な列がわからずすみません)
なので発注リストに出力した分は『未処理』から『発注済』になるようになると嬉しいです
お二方ありがとうございます。
残念ながら私の力不足でワークシート名の書き換えが間違っているのかどちらもうまく動かず。。。
本来のもっとごちゃごちゃしたデータを例に示した形になるべく近づけたのですが何がいけないのか。。。
もう少し頑張ってみます。
tom04様
ご教授ありがとうございます!
例に提示しました分同じように動きました!
実ファイルに転載してみたところ28行目で
.Cells(c.Row, myCol) = .Cells(c.Row, "B") * wS2.Cells(i, "C")
となってしまいます。
知識不足で申し訳ありませんが何が原因かわかりますでしょうか。。。