[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『VBAによるビンパッキング問題』（iraaa）
30種類くらいの商品を一定のサイズの段ボールにどう詰めるのかの表をエクセルで作りたいです。
各商品はそれぞれ1〜2000個くらいの数量で、段ボールは商品の種類に関係なく、200ずつ詰められます。
最終的には各段ボール1,2,3…にどの商品がどれだけ入っているか、下記みたいな表を出したいです。各段ボールはそれぞれ合計200以下の数量になります。
段ボール1 段ボール2 段ボール3・・・
商品A 数量100 100
商品B 数量350 100 200 50
商品C 数量1000 150 200
・
・
・
Excelの関数のみでこの表と同等のものは200を上限として上のセルから持ってきた数値を引く、みたいな感じでで作れたのですが、各商品数量を200で割って、余がでたものを200の段ボールに詰める効率的な組み合わせを探す方が、１商品をなるべく複数の段ボールに割らずに詰められるのではないかと思っています。（この表だと商品Bは本来200と150と二つの段ボールに分けるだけで済んだのに、3つに分かれてしまう）
下記がほぼ同じ質問かと思いますが、VBAの途中がどういう処理をしているのかわかりませんでした。
下記のリンクのVBAの意味の解説でも構いませんので、教えていただけませんか？
https://www.excel.studio-kazu.jp/kw/20120410160047.html
＜ 使用 Excel：Office365、使用 OS：Windows10 ＞
ビン・パッキング問題は、難しい問題の一つのようですね。（カッティングストック問題と等価）
とりあえず、参照スレッドのコードについての説明をしておきます。 （著作権は kanabun氏に帰属します）
【前提】
定尺長さ： 5450
切出しデータ
長さ 要求数
3500 3
2150 2
1801 10
500 15
150 20
【実行結果】
A B C D E F G H I J K L
1 定尺 製品 149 149 149 0 47 47 149 50 5000
2 5450 3500 3500 3500 3500 2150 1801 1801 1801 500 150
3 3500 1801 1801 1801 2150 1801 1801 500 500 150
4 3500 500 1801 1801 500 500 150
5 2150 500 500 500
6 2150 150 500 500
7 1801 500 500
8 1801 500 150
9 1801 500 150
10 1801 150
11 1801 150
12 1801 150
13 1801 150
14 1801 150
15 1801 150
16 1801 150
17 500 150
18 500 150
19 500 150
20 500 150
21 500 150
22 500 150
23 500 150
: ...
: ...
49 150
50 150
51 150
【コード】(グラフ描画は省略しました。)
Sub Try1()
Dim cons As Long
Dim c As Range
Dim r As Range
Dim j As Long
Dim ok As Boolean
With ActiveSheet
cons = .[A2].Value '[A2]に定尺を書き込んでおく
.[D1].CurrentRegion.ClearContents
'[B2]以下に 切り出し製品リストを書き込んでおく
Set r = Excel.Range(.[B2], .[B65536].End(xlUp))
'各列毎にひとつの材料を採り、1行目には切り出し後の残量
' 2行目以降に切り出し結果を書き込むものとする。
Dim usCount As Long
usCount = 1
.[D1].Item(1, usCount).Value = cons '初期設定
'B列には、製品リストを上から順に大きいものから並べておき、
'大きいものから切り出していく（大方針）
For Each c In r
If c.ID = "" Then
ok = False
Do
For j = 1 To usCount
With [D1].Item(1, j)
If .Value >= c.Value Then ' 切り出し可能なら
.Value = .Value - c.Value '残量を更新
'切り出し数量を書き込み
Cells(Rows.Count, .Column).End(xlUp).Offset(1).Value = c.Value
c.ID = "ok"
ok = True
Exit For
End If
End With
Next
If Not ok Then '今までの材料では切り出せなかったら、
usCount = usCount + 1 '材料を新たに使用することとし、
[D1].Item(1, usCount).Value = cons '定尺追加
End If
Loop Until ok
End If
Next
End With
End Sub
（γ） 2022/03/21(月) 23:59
| 各商品数量を200で割って、余がでたものを200の段ボールに詰める効率的な組み合わせを探す方が、 | １商品をなるべく複数の段ボールに割らずに詰められるのではないかと思っています。 私もそう思います。
各商品の QUOTIENT(数量,200) 個のロットはその商品単独によるロットとし、 MOD(数量,200) だけについて、組み合わせを考えればよいと思いますね。
ちなみに、以前のサイトの方法は、下記のwikipediaにある、アルゴリズムBに相当するものと思います。
各商品の MOD(数量,200)をキーとして降順にソートしたうえで、 そのロジックを使えばよいと思います。 なお、書き込む際に、どの商品のものかも合わせて書き込むようにすればよいでしょう。 簡単な修正で済みます。
（γ） 2022/03/23(水) 11:12
仮のデータも示しましたので、 元のコードをステップ実行して、ロジックを確認すると理解につながると思います。
少し改善したものを示して、私はこれで区切りとしておきます。
サンプルデータは以下のとおり。
・商品Aから商品Zまで26商品があり、各商品の数量は以下のとおりとします。 ・1ロットには200個収納できるものとしました。
■データシートのレイアウト （元データ部分）
A列 B列 C列 D列
1行
2行 商品 数量 単独Lot 残余
3 A 201 1 1 ← 200個だけで単独のロットを割り当て。残り1個を混合ロットに。
4 B 672 3 72
5 C 603 3 3 C3: =QUOTIENT(B3,$J$1)
6 D 610 3 10 D3: =MOD(B3,$J$1)
7 E 374 1 174 以下コピー
8 F 707 3 107 （★ J1 にはロットの収納上限である200をセットしておきます。）
9 G 124 0 124
10 H 280 1 80
11 I 225 1 25
12 J 573 2 173
13 K 227 1 27
14 L 257 1 57
15 M 328 1 128
16 N 658 3 58
17 O 158 0 158
18 P 690 3 90
19 Q 366 1 166
20 R 591 2 191
21 S 660 3 60
22 T 529 2 129
23 U 693 3 93
24 V 783 3 183
25 W 345 1 145
26 X 321 1 121
27 Y 447 2 47
28 Z 214 1 14
■試算部分のレイアウト
G列 H I J K L M N O P Q R S T U V W X Y Z AA AB AC AD AE AF AG AH AI AJ AK
1行 200 5 3 1 0 24 42 8 11 0 18 22 0 30
2 商品 数量 単独 残余 L1 L2 L3 L4 L5 L6 L7 L8 L9 L10 L11 L12 L13
3 R 591 2 191 191 R 183 V 174 E 173 J 166 Q 158 O 145 W 129 T 128 M 124 G 121 X 107 F 90 P
4 V 783 3 183 3 C 14 Z 25 I 27 K 10 D 47 Y 60 S 72 B 58 N 57 L 93 U 80 H
5 E 374 1 174 1 A
6 J 573 2 173
7 Q 366 1 166 ★G:J列は、A:D列を残余をキーに降順に並び替えたもの。
8 O 158 0 158 ★ J1 にはロットの収納上限である200をセットしておく。
9 W 345 1 145 ★ L列より右の列は、端数の商品を、各ロットに混合してどう収めるかを計算した領域。
10 T 529 2 129 ★ L2〜AJ2はロット番号のつもり。
11 M 328 1 128
12 G 124 0 124
13 X 321 1 121
14 F 707 3 107
15 U 693 3 93
16 P 690 3 90
17 H 280 1 80
18 B 672 3 72
19 S 660 3 60
20 N 658 3 58
21 L 257 1 57
22 Y 447 2 47
23 K 227 1 27
24 I 225 1 25
25 Z 214 1 14
26 D 610 3 10
27 C 603 3 3
28 A 201 1 1
■下記のコードでは、端数部分をどこに収めるかを
元表のF列にも書き込んでもいます。
A列 B C D E列
1行
2 商品 数量 単独 残余 端数部分の収納ロット
3 A 201 1 1 Lot 1
4 B 672 3 72 Lot 9
5 C 603 3 3 Lot 1
6 D 610 3 10 Lot 5
7 E 374 1 174 Lot 3
8 F 707 3 107 Lot 12
9 G 124 0 124 Lot 10
10 H 280 1 80 Lot 13
11 I 225 1 25 Lot 3
12 J 573 2 173 Lot 4
13 K 227 1 27 Lot 4
14 L 257 1 57 Lot 11
15 M 328 1 128 Lot 9
16 N 658 3 58 Lot 10
17 O 158 0 158 Lot 6
18 P 690 3 90 Lot 13
19 Q 366 1 166 Lot 5
20 R 591 2 191 Lot 1
21 S 660 3 60 Lot 8
22 T 529 2 129 Lot 8
23 U 693 3 93 Lot 12
24 V 783 3 183 Lot 2
25 W 345 1 145 Lot 7
26 X 321 1 121 Lot 11
27 Y 447 2 47 Lot 7
28 Z 214 1 14 Lot 2
<<参考コード>> なお、端数部分の降順にソートする部分は、そちらで追加してください。
Sub Try2()
Dim cons As Long
Dim rng As Range
Dim c As Range
Dim j As Long
Dim k As Long
Dim jj As Long
Dim ok As Boolean
Dim myRow As Long
cons = [J1].Value '[A2]に定尺を書き込んでおく
[L1].CurrentRegion.ClearContents
'端数の降順でならび替えておきます。
Set rng = Excel.Range([J3], Cells(Rows.Count, "J").End(xlUp))
'各列毎にひとつの材料を採り、1行目には切り出し後の残量
' 2行目以降に切り出し結果を書き込むものとする。
Dim usCount As Long
usCount = 1
[L1].Item(1, usCount).Value = cons '初期設定
[L2].Value = "Lot " & usCount 'ロット番号
'B列には、製品リストを上から大きいものから小さいものの順に並べておき、
'大きいものから切り出していく（大方針）
For Each c In rng
ok = False
Do
For j = 1 To usCount
jj = 2 * j - 1
With [L1].Item(1, jj)
If .Value >= c.Value Then ' 切り出し可能なら
.Value = .Value - c.Value '残量を更新
'切り出し数量を書き込み
myRow = Application.Max(2, Cells(Rows.Count, .Column).End(xlUp).Row)
Cells(myRow, .Column).Offset(1).Value = c.Value
Cells(myRow, .Column).Offset(1).Offset(, 1) = c.Offset(, -3).Value
ok = True
Exit For
End If
End With
Next
If Not ok Then '今までの材料では切り出せなかったら、
usCount = usCount + 1 '材料を新たに使用することとし、
[L1].Item(1, 2 * usCount - 1).Value = cons '定尺追加
[L2].Item(1, 2 * usCount - 1).Value = "Lot " & usCount
End If
Loop Until ok
Next
'元の表にロットを書き込む。
'各商品別に、それぞれの梱包ロット名を書き込む
Dim rng2 As Range
Dim myRow2 As Long
Set rng2 = Range("A3", Cells(Rows.Count, "A").End(xlUp))
For k = 12 To Cells(2, Columns.Count).End(xlToLeft).Column Step 2
For j = 3 To Cells(Rows.Count, k + 1).End(xlUp).Row
myRow2 = Application.Match(Cells(j, k + 1), rng2, 0)
Cells(myRow2 + 2, "E").Value = Cells(2, k).Value
Next
Next
End Sub （γ） 2022/04/12(火) 11:22
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.