[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『最小限の組み合わせを見つける方法』(すもも)
長さ5mの片方に受口がついた管を、いろいろな長さに切って使う場合
何本買えば良いのか、自動的に最小となる組み合わせが探せますでしょうか?
ただし、片方に受口がついているため、受口同士を組み合わせることはNGです。
例
1本目.受口付3m+1.5m+0.5m…残りの管0m
2本目.受口付1.5m+1m+0.5m…残りの管2.0m
3本目.受口付4m…残りの管1m
4本目.1m+0.5m…残りの管 受口付3.5m
この場合、4本目をを2本目に持って行けば、3本の購入で済みます。
こんな感じで最小本数となる組み合わせを自動的に探したいです。
何か良い方法はないでしょうか?
< 使用 Excel:Excel2016、使用 OS:Windows10 >
回答ではありません。
こういうのは、下手するととんでもない計算量になるので、もう少し補強情報が必要です。
現実に処理したサンプルを出していただけませんか?(それで、大体のイメージがつかめます)
最多のケースでは何本目まであるんですか?
切り出す部品数は、1本につき、何個ぐらいが目安になりますか?
最短は0.5mなんですか? それとも0.25mとか0.65mなんて長さの切り取りもあり得るんですか?
受け口を残して切り取る場合、何m何cmまで取れるんですか?
つかぬことですが、 いつも5mの新品から切り取るんですか?(在庫の端材を使うってことはないんですか?)
切り残しは、次回の切り取り作業で、在庫端材として使えると思うので、 そんなにシビアに最少本数にこだらなくてもいいような気がするんですが、 まぁまぁ最少に抑えられたポイね、なんて精度では許されないのでしょうか? ( 半平太) 2019/01/11(金) 23:40
私にはできないですが、質問者さんがなにを頼もうとしているか 知ってもらいたいので、少し捕捉を、、、
ナップサック問題 で検索してください 大変さが少しはわかっていただけると思います
あと、情報として、刃物の幅も考慮に入れたほうが、よくないですかね
(稲葉) 2019/01/12(土) 05:58
最多のケースは最大30本くらいです。
切取る最短は0.12mとかもあります。
1本に付き、最大で10本くらい切り取ると思います。
受口を残して切り取る長さは、受口がない部材もありますので、マックスまで使えます。
常に新品から切り取ります。
やはり、計算で何とかなるような感じではないですよね。
もう少し、考えてみます。
また、何か良い案があったらよろしくお願いします。
(すもも) 2019/01/12(土) 15:45
その昔(15年くらい前)私がまだ某モーグにお邪魔していたころに作ったコードがあったのでそれをちょっこと改良してみました。
一応↓くらいまでは動かしてみましたけど、、あまりすごいことは検証していません。
切断出来ない端管が出た時は、材料が足りませんから受口付の本数を増やしてあげて下さい。
これもね、、物凄〜〜〜く前に書いたコードだから、コードに幼さがあるし、駄目だったらごめんなさいね(^^;
ちょっとパソコンを整理しないと、何がなんだか( ̄▽ ̄;)
受口付 本数 端管 本数 定尺 切り代 切断明細 4000 1 1000 1 5000 5 1500,1500,1500,残485 3500 1 1000 1 1500,1500,1500,残485 3000 2 1000 1 3000,1500,残490 1500 1 1500 2 3000,1500,残490 3500 1 500 1 3000,1500,残490 3500 1 500 1 3000,1500,残490 3000 2 500 1 3000,1500,残490 3500 1 500 1 3000,1500,残490 3500 1 500 1 3000,1000,500,残485 3500 1 500 1 3000,1000,500,残485 3000 2 500 1 3000,1000,500,残485 1500 1 1000 1 3000,1000,500,残485 3500 1 1500 2 3000,1000,500,残485 3000 2 500 1 3000,1000,500,残485 3500 1 500 1 3500,1000,残490 3500 1 500 1 3500,500,500,残485 3500 1 1000 1 3500,500,500,残485 3000 2 1500 2 3500,500,500,残485 3000 2 500 1 3500,500,500,残485 500 1 3500,500,500,残485 500 1 3500,500,500,残485 500 1 3500,500,500,残485 500 1 3500,500,残990 500 1 3500,残1495 500 1 4000,残995 500 1 1000 1 1500 2 500 1 500 1 500 1 1000 1 1500 2
'これが完成版 '2019/01/12 Sub てすと() Dim MyA As Variant Dim MyB As Variant Dim w As Variant Dim ww() As Variant Dim 切断リスト As Variant Dim 端数リスト As Variant Dim 端管リスト As Variant Dim 残リスト() As Variant Dim x As Variant Dim y As Variant Dim 最小本数A As Long Dim 最小本数B As Long Dim 端数 As Double Dim i As Long Dim j As Long Dim n As Long Dim k As Long Dim kk As Variant Dim ii As Long Dim 定尺 As Double Dim 切り代 As Double Dim 残 As Double Dim MyFlg As Boolean With Sheets("受口付") 定尺 = .Range("E2").Value 切り代 = .Range("F2").Value 'データを配列に取得 MyA = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 2).Value MyB = .Range("C2", .Range("C" & .Rows.Count).End(xlUp)).Resize(, 2).Value End With '切断リストの作成 切断リスト作成 MyA, 切断リスト, 最小本数A '並び替え QuickSort 切断リスト, 1, LBound(切断リスト, 1), UBound(切断リスト, 1) k = 1 '多段配列用w ReDim w(LBound(切断リスト, 1) To UBound(切断リスト, 1)) '各項目を取得 For i = LBound(w) To UBound(w) ReDim x(0) x(0) = Val(切断リスト(i, 1)) w(i) = x Next ReDim 端数リスト(1 To 最小本数A, 1 To 1) k = 2 ReDim Preserve w(LBound(切断リスト, 1) To UBound(切断リスト, 1)) For i = LBound(切断リスト, 1) To UBound(切断リスト, 1) If 定尺 - (切断リスト(i, 1) + 切り代) > 0 Then 端数 = 定尺 - (切断リスト(i, 1) + 切り代) 端数リスト(i, 1) = 端数 x = w(i) ReDim Preserve x(1) x(1) = 端数リスト(i, 1) w(i) = x End If Next '二次元配列に変換 ReDim Preserve ww(LBound(w) To UBound(w), 1 To UBound(w(1)) + 1) For i = LBound(ww, 1) To UBound(ww, 1) For j = LBound(w(i)) To UBound(w(i)) ww(i, j + 1) = w(i)(j) Next Next '並び替え QuickSort ww, UBound(ww, 2), LBound(ww, 1), UBound(ww, 1) '多段配列に分解 For i = LBound(ww, 1) To UBound(ww, 1) ReDim x(1) For j = LBound(ww, 2) To UBound(ww, 2) x(j - 1) = Val(ww(i, j)) Next w(i) = x Next 切断リスト作成 MyB, 端管リスト, 最小本数B QuickSort 端管リスト, 1, LBound(端管リスト, 1), UBound(端管リスト, 1) For i = LBound(w, 1) To UBound(w, 1) For ii = LBound(端管リスト, 1) To UBound(端管リスト, 1) If 端管リスト(ii, 1) > 0 Then x = w(i) If Val(x(UBound(x))) - (端管リスト(ii, 1) + 切り代) > 0 Then k = UBound(x) + 1 ReDim Preserve x(k) 残 = Val(x(UBound(x) - 1)) - (端管リスト(ii, 1) + 切り代) x(k - 1) = 端管リスト(ii, 1) x(k) = 残 端管リスト(ii, 1) = 0 w(i) = x End If End If Next Erase x Next For i = LBound(w) To UBound(w) w(i) = Join(w(i), ",") k = InStrRev(w(i), ",") w(i) = "'" & Left(w(i), k) & "残" & Right(w(i), Len(w(i)) - k) Next k = 0 For i = LBound(端管リスト, 1) To UBound(端管リスト, 1) For j = LBound(端管リスト, 2) To UBound(端管リスト, 2) If 端管リスト(i, j) > 0 Then MyFlg = True ReDim Preserve 残リスト(k) 残リスト(k) = 端管リスト(i, j) k = k + 1 End If Next Next With Sheets("受口付") .Range("G:H").Clear .Range("G1").Value = "切断明細" .Range("G2").Resize(UBound(w)).Value = Application.Transpose(w) MsgBox "必要本数は 定尺 " & 定尺 & " mmを" & vbCrLf & 最小本数A & " 本です。" If MyFlg = False Then MsgBox "切断出来なかった端管はありません" Else .Range("H1").Value = "切断出来なかった端管" .Range("H2").Resize(UBound(残リスト) + 1).Value = Application.Transpose(残リスト) .Range("A1").CurrentRegion.EntireColumn.AutoFit MsgBox Join(残リスト, vbCrLf) & vbCrLf & "を切断出来ませんでした" End If End With Erase MyA, MyB, w, ww, 切断リスト, 端数リスト, 端管リスト End Sub Private Sub 切断リスト作成(ByRef x As Variant, ByRef y As Variant, ByRef 最小本数 As Long) Dim i As Long Dim j As Long Dim k As Long For i = 1 To UBound(x, 1) 最小本数 = 最小本数 + x(i, 2) Next i ReDim 切断リスト(1 To 最小本数, 1 To 1) For i = 1 To UBound(x, 1) For j = 1 To x(i, 2) If j > 1 Then k = k + 1 切断リスト(k, 1) = Val(x(i, 1)) Else k = k + 1 切断リスト(k, 1) = Val(x(i, 1)) End If Next j Next i y = 切断リスト End Sub Private Sub QuickSort(MySAry As Variant, ByVal MySKey As Long, ByVal MySLeft As Long, ByVal MySRight As Long) Dim MySMid As Double Dim i As Long, j As Long, n As Long Dim MySLBound As Long, MySUBound As Long Dim MyStmp As String MySLBound = LBound(MySAry, 2) MySUBound = UBound(MySAry, 2) MySMid = MySAry((MySLeft + MySRight) \ 2, MySKey) i = MySLeft j = MySRight Do Do While MySAry(i, MySKey) > MySMid i = i + 1 Loop Do While MySAry(j, MySKey) < MySMid j = j - 1 Loop If i >= j Then Exit Do For n = MySLBound To MySUBound MyStmp = MySAry(i, n) MySAry(i, n) = MySAry(j, n) MySAry(j, n) = MyStmp Next i = i + 1 j = j - 1 Loop If MySLeft < i - 1 Then QuickSort MySAry, MySKey, MySLeft, i - 1 If MySRight > j + 1 Then QuickSort MySAry, MySKey, j + 1, MySRight End Sub v(=∩_∩=)v (SoulMan) 2019/01/12(土) 16:50
わざわざ、本当にありがとうございました。
(すもも) 2019/01/12(土) 19:42
>受口を残して切り取る長さは、受口がない部材もありますので、マックスまで使えます。
そうなると、こう言う事(受口付が残る)は起きないんじゃないですか? ↓ >4本目.1m+0.5m…残りの管 受口付3.5m
受口が必要ない切出しなのに、なぜ受口付の部材を使うのでしょうか? ちょっと理解できないです。
( 半平太) 2019/01/12(土) 20:25
実際には、受口付しかない部材もあったり、定尺120から4m等いろいろあったり、マックスまで使ってはNGで
少なくとも0.3mは残すとか、その時々で条件がいろいろあるのです。
よって、一番標準的な例題で質問させてもらいました。
説明下手ですいません。
(すもも) 2019/01/15(火) 17:02
SoulManさんの対策で事が済むんなら、私のこのレスは無視してください。
>一番標準的な例題
言葉の選択の問題でしょうが、特殊な例と言われた方が私はしっくり来ます。
「標準的な」状況は、全て新品の5m部材を切るなんてハッピーな状況は滅多になく、 在庫の半端材を優先的に使わなければならないんじゃないですか?
そうなると、「特殊な」状況が処理できるマクロなんか作ったって使えるシーンは少ない・・ (使えないと言った方が早い気がします。)
>実際には、受口付しかない部材もあったり、 >定尺120から4m等いろいろあったり、 >マックスまで使ってはNGで 少なくとも0.3mは残すとか、 >その時々で条件がいろいろあるのです。
色々あるんだろうなぁとは思いますが、 「その時々」というものをエクセルで処理できる状況にまで整理しないと先に進めないと思います。
私の想像では、最後は適当に処理しているハズだと思っています。 (そんなシビアな計画は人間に作れないし、多少の半端材は、次の仕事に使えばいいので)
つまり「在庫の○○を△△m 必ず使う事。最少本数で実現する事」なんて命令はまず無い。
あるのは「○○を××mと受口付を□□mをキッチリ切り取る事、在庫は無駄なく使い、ロスを少なくする事」と言う命令であり、
(徐々にではあるが)「最近、無駄な半端材の在庫が減ってきたなぁ」と思える状態になれればいいだけじゃないですか?
じゃ、「時々」の状況をどう整理すればいいのー、と言う話になりますが、 「サンプルはありません」という事では話になりません。
無い訳ないと思います。毎回実際にやっている実例を書き出して貰えばいいことですから。 (何を切り出し、どんな在庫を使おうと計画したのか)
そしたら、こちらでどう整理すればいいかアイデアが浮かぶかも知れません。
当初は1例でいいと思ったのですが、色々なケースがあるようなので、 種類が異なると思えそうな実例サンプルを2例アップしていただければと思います。
それは無理ということであれば、私は降ります。
( 半平太) 2019/01/16(水) 00:05
後々、他の方がこのトピを見たときに残管処理も書いといてくれよぉ〜〜〜 ってなっても困るから、一応、書いておきます。
基本、最初のコードと変わってません。(15年間、成長してへんのんかぇぇぇ(^^;)
それよりも答え、、、あってますぅぅぅぅ????
残管 本数 端管 本数 切り代 切断明細 4000 1 1000 1 8 1500,1500,500,120,120,120,残92 3500 1 1000 1 1500,1500,120,120,120,残100 3000 2 1000 1 1500,1500,120,120,120,残100 1500 1 1500 2 1500,1500,120,120,120,残100 3500 1 500 1 1500,1500,120,120,120,残100 3500 1 500 1 1500,1500,120,120,120,残100 3000 2 500 1 1500,1500,120,120,120,残100 3500 1 500 1 1500,1500,120,120,120,残100 3500 1 500 1 1500,1500,120,120,120,残100 3500 1 500 1 1500,1500,120,120,120,残100 3000 2 500 1 1500,1500,残484 1500 1 1000 1 1500,1500,残484 3500 1 1500 2 1500,1000,残484 3000 2 500 1 1500,1000,残484 3500 1 500 1 1500,1000,残484 3500 1 500 1 1500,1000,残484 3500 1 1000 1 1000,1000,500,残476 3000 2 1500 2 1000,1000,500,残476 3000 2 500 1 1000,1000,500,残476 3500 1 500 1 1000,1000,500,残476 3000 2 500 1 1000,1000,500,残476 3000 2 500 1 1000,500,500,500,残468 500 1 500,500,500,500,500,残460 500 1 500,500,500,500,500,残460 500 1 500,500,500,500,500,残460 500 1 500,500,500,500,500,残460 1000 1 500,500,500,500,500,残460 1500 2 500,500,500,残1476 120 10 残1500 500 1 残1500 500 1 1000 1 1500 2 500 1 1000 1 1500 2 500 1 500 1 500 1 1000 1 1500 2 120 10 500 1 500 1 1000 1 1500 2 500 1 1000 1 1500 2 500 1 500 1 500 1 500 1 1000 1 1500 2 120 10 500 1 500 1 1000 1 1500 2 500 1 1000 1 1500 2 500 1 500 1 500 1 1000 1 1500 2 1500 2
Option Explicit Sub 残管処理() Dim MyA As Variant Dim MyB As Variant Dim w As Variant Dim ww() As Variant Dim 切断リスト As Variant Dim 端数リスト As Variant Dim 端管リスト As Variant Dim 残リスト() As Variant Dim x As Variant Dim y As Variant Dim 最小本数A As Long Dim 最小本数B As Long Dim 端数 As Double Dim i As Long Dim j As Long Dim n As Long Dim k As Long Dim kk As Variant Dim ii As Long Dim 切り代 As Double Dim 残 As Double Dim MyFlg As Boolean With Sheets("残管処理") 切り代 = .Range("E2").Value 'データを配列に取得 MyA = .Range("A2", .Range("A" & .Rows.Count).End(xlUp)).Resize(, 2).Value MyB = .Range("C2", .Range("C" & .Rows.Count).End(xlUp)).Resize(, 2).Value End With '本管リストの作成 切断リスト作成 MyA, 切断リスト, 最小本数A '並び替え QuickSort 切断リスト, 1, LBound(切断リスト, 1), UBound(切断リスト, 1) k = 1 '多段配列用w ReDim w(LBound(切断リスト, 1) To UBound(切断リスト, 1)) '各項目を取得 For i = LBound(w) To UBound(w) ReDim x(0) x(0) = Val(切断リスト(i, 1)) w(i) = x Next ReDim 端数リスト(1 To 最小本数A, 1 To 1) ReDim Preserve w(LBound(切断リスト, 1) To UBound(切断リスト, 1)) '二次元配列に変換 ReDim Preserve ww(LBound(w) To UBound(w), 1 To UBound(w(1)) + 1) For i = LBound(ww, 1) To UBound(ww, 1) For j = LBound(w(i)) To UBound(w(i)) ww(i, j + 1) = w(i)(j) Next Next '並び替え QuickSort ww, UBound(ww, 2), LBound(ww, 1), UBound(ww, 1) '多段配列に分解 For i = LBound(ww, 1) To UBound(ww, 1) ReDim x(0) For j = LBound(ww, 2) To UBound(ww, 2) x(j - 1) = Val(ww(i, j)) Next w(i) = x Next 切断リスト作成 MyB, 端管リスト, 最小本数B QuickSort 端管リスト, 1, LBound(端管リスト, 1), UBound(端管リスト, 1) For i = LBound(w, 1) To UBound(w, 1) For ii = LBound(端管リスト, 1) To UBound(端管リスト, 1) If 端管リスト(ii, 1) > 0 Then x = w(i) If Val(x(UBound(x))) - (端管リスト(ii, 1) + 切り代) > 0 Then k = UBound(x) + 1 ReDim Preserve x(k) 残 = Val(x(UBound(x) - 1)) - (端管リスト(ii, 1) + 切り代) x(k - 1) = 端管リスト(ii, 1) x(k) = 残 端管リスト(ii, 1) = 0 w(i) = x End If End If Next Erase x Next For i = LBound(w) To UBound(w) w(i) = Join(w(i), ",") k = InStrRev(w(i), ",") w(i) = "'" & Left(w(i), k) & "残" & Right(w(i), Len(w(i)) - k) Next k = 0 For i = LBound(端管リスト, 1) To UBound(端管リスト, 1) For j = LBound(端管リスト, 2) To UBound(端管リスト, 2) If 端管リスト(i, j) > 0 Then MyFlg = True ReDim Preserve 残リスト(k) 残リスト(k) = 端管リスト(i, j) k = k + 1 End If Next Next With Sheets("残管処理") .Range("F:G").Clear .Range("F1").Value = "切断明細" .Range("F2").Resize(UBound(w)).Value = Application.Transpose(w) If MyFlg = False Then MsgBox "切断出来なかった端管はありません" Else .Range("G1").Value = "切断出来なかった端管" .Range("G2").Resize(UBound(残リスト) + 1).Value = Application.Transpose(残リスト) .Range("A1").CurrentRegion.EntireColumn.AutoFit MsgBox Join(残リスト, vbCrLf) & vbCrLf & "を切断出来ませんでした" End If End With Erase MyA, MyB, w, ww, 切断リスト, 端数リスト, 端管リスト End Sub Private Sub 切断リスト作成(ByRef x As Variant, ByRef y As Variant, ByRef 最小本数 As Long) Dim i As Long Dim j As Long Dim k As Long For i = 1 To UBound(x, 1) 最小本数 = 最小本数 + x(i, 2) Next i ReDim 切断リスト(1 To 最小本数, 1 To 1) For i = 1 To UBound(x, 1) For j = 1 To x(i, 2) If j > 1 Then k = k + 1 切断リスト(k, 1) = Val(x(i, 1)) Else k = k + 1 切断リスト(k, 1) = Val(x(i, 1)) End If Next j Next i y = 切断リスト End Sub Private Sub QuickSort(MySAry As Variant, ByVal MySKey As Long, ByVal MySLeft As Long, ByVal MySRight As Long) Dim MySMid As Double Dim i As Long, j As Long, n As Long Dim MySLBound As Long, MySUBound As Long Dim MyStmp As String MySLBound = LBound(MySAry, 2) MySUBound = UBound(MySAry, 2) MySMid = MySAry((MySLeft + MySRight) \ 2, MySKey) i = MySLeft j = MySRight Do Do While MySAry(i, MySKey) > MySMid i = i + 1 Loop Do While MySAry(j, MySKey) < MySMid j = j - 1 Loop If i >= j Then Exit Do For n = MySLBound To MySUBound MyStmp = MySAry(i, n) MySAry(i, n) = MySAry(j, n) MySAry(j, n) = MyStmp Next i = i + 1 j = j - 1 Loop If MySLeft < i - 1 Then QuickSort MySAry, MySKey, MySLeft, i - 1 If MySRight > j + 1 Then QuickSort MySAry, MySKey, j + 1, MySRight End Sub v(=∩_∩=)v (SoulMan) 2019/01/16(水) 19:25
(すもも) 2019/01/16(水) 20:06
受口付 というかぁ、、定尺がある時は↓こんな感じで
受口付 本数 端管 本数 定尺 切り代 4000 1 1000 1 5000 5 3500 1 1000 1 3000 2 1000 1 1500 1 1500 2 3500 1 500 1 3500 1 500 1 3000 2 500 1 3500 1 500 1 3500 1 500 1 3500 1 500 1
残管の時は↓こんな感じでSheetにあらかじめ数量を入力しておいてください。
残管 本数 端管 本数 切り代 4000 1 1000 1 8 3500 1 1000 1 3000 2 1000 1 1500 1 1500 2 3500 1 500 1 3500 1 500 1 3000 2 500 1 3500 1 500 1 3500 1 500 1
ほんとだったら、コードの中にSheet名を記入したり、エラー処理をするのが基本なんだけど、、
あくまでもサンプルですから、その辺はお勉強してアレンジしてみてください。
その対象のSheetをアクティブにしておかないとエラーになりますね、、、多分、、、
不親切、ですね。。。書き直しましょうか???←また、時間があったらね。
今日ね、、、ちょっと手術をして痛いのよぉ、、、( ノД`)シクシク…
実は、私の兄は会社を経営してて材料を切り出すんですよね。
で、昔、兄に頼まれて使ってみたら?ってあげた記憶がありますから、、今でも使ってるんじゃないかと思います。
そういう意味ではあってるんでしょうね????←全然、違ってたりして(笑)
受口付 と 残管 Sheetのレイアウトが違うからその辺を工夫されたらいいと思います。
まぁ、、ヒント程度で、、、、
では、では、 (SoulMan) 2019/01/16(水) 20:23
書き直すったて、、、Sheet名を入れるだけだから、、上のコードを書き直しておきました。
それぞれ標準モジュールに張り付けて、
受口付 シートと
残管処理 シートに それぞれ、データを入力してみて下さい。
エラー処理は、、、お勉強という事で、、、、
では、では、、 (SoulMan) 2019/01/16(水) 20:49
お手数おかけしました。
手、お大事にされてください!
半平太さんもありがとうございました!
(すもも) 2019/01/16(水) 20:54
あっ、Private Sub QuickSortとPrivate Sub 切断リスト作成は、共通ですから、、一つでいいですって、、、
それくらいわかります、、、よね???(笑)
おやすみなさいzzzzzzzzzzzzzz (SoulMan) 2019/01/16(水) 20:59
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.