[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『組み合わせを選ぶ』（みすたーびーん）
ちょっと複雑ですが、２０個の数字（整数）があります。その中の数字の和がある数未満になる組み合わせ方を知る方法を知りたいのですが、教えていただけますか？組み合わせる個数は決まっていません。２個でもいいし、１５個でもいいんです。
よろしくお願いいたします。
追記ですが、未満というのは、できるだけ近い｛未満｝です。
マクロでないと難しそうですが、まず、『組み合わせ方を知る』ってのは、どういうことですか。何通りかあれば、条件に見合った、選択した数字すべてを列挙させるわけですか？それとも、出来るだけ近い未満の数字を求めるのですか？それか、何通りあるかを求めるわけですか？
次に、『ある数未満』とありますが、これは決まった数字なのですか？それとも、可変ですか？
ちょっと、これでは、達人である先生方も、お分かりにならないのではないでしょうか。ちなみに、私には、かなり難しい質問に思われます。 （ピョン）
材料から部品を作るとすると普通、長いものから取ったりしないの？ 短い部品は比較的たくさんとれるわけだし。 切るわけだから未満というのはわかるけど、 たとえば4mから10本、計算上余り1mmです〜 というんじゃ、実際 9本しかとれないだろうし。 何本取るかにもよって余りを変化させなければいけないだろうから、 VBAで総当りっぽいね。
20個の数字は固定なのかな？ 数字が全てでないことには、自分なんかにはさっぱりですね。 （ramrun）
なにかキマリがあるなら、こんなの参考になるのでは？ [[20030724233943]]『金種表』（ゆーか）
そうですね、明快な解答がもしかしたら有るのかな、と興味持ってたんですが。 私の脳みそでは ∞ しか浮かばず。 ＞その必要な長さが、いろいろな長さがあって が一番ポイントですよね。 （みすたーびーん） さん、見てらしたら返信下さいね。 きっと解決してくれますよ。 （jun53）
実際に欲しい長さのパイプは、160mm×２本、276mm×６本、293mm×３本、360mm×４本
563mm×２本、610mm×３本、650mm×１０本です。パイプは4m、2m、1m、60cm、があります。4mを１本買った方が、2m2本買うよりも安いので、なるべく長いのを買って、切って使いたいと思います。しかし、切ると切り幅がでてしまうので、たとえば10mのパイプから1mのパイプは９本しか取れません。切り幅は1mmです。
以上のようなことです。これを計算して、できるだけ無駄のでないようにしたいということです。こんなことエクセルでできるのでしょうか？
横から割り込んでスンマヘン。 コレはあくまで私個人の愚見でおまして、みすたーびーんさんの問いかけのお答えには なってえしまへんさかい、軽く読み流しておくんなはれや。
例えば990mmの注文が一本有ったとしまへんか。みすたーびーんさんやったら9mmのロス で済む1mモンを仕入れてそれに当てまっか？そやおまへんわなぁ。当然割安の4mモンか cutして残りの3009mmをストックにして次の受注を待ちますわなぁ。その3009mmを切り 落としていって27mmのロスが出てもロスの度合いは一緒ですさかい、割安な4mモンを使 うた方が有利な事は明白ですわいな。 こうした案配に突き詰めていくとcutする手間賃と切り幅ロス1mmの出えへん、2m,1m 600mmのそれぞれジャストの注文の時だけそれを使って、後は全て割安な4mモンから切 り落としていった方が長い目で見てコストダウンに繋がると思いまんねんけどどうでっ しゃろ？
よしんば百歩譲って、例えばこの注文の場合の結果が、エクセル（多分マクロやなかっ たら無理）で拾って4m,2 2m,1 600mm,1 が最適やと出たとしても、どのm数からどのサ イズを何本cutするんが分からんかったら、なんの意味も持ちまへんわなぁ。 (160+1) (160+1)*2 (276+1) (276+1)*2 (276+1)*3 (..... (293+1) (293+1)*2 (293+1)*3 っちゅう案配に全て式を展開して、その中で最適な数値をマクロに捜ささなあきまへん （ちょっとやそっとの回数やおまへん）からマクロを組む言うたかて相当骨折れまっせ え、えぇ。
まあ、そら、前段のお三方は、なんちゅうたってマクロの権化みたいな方達ですさかい 造作もなく組んでしまいまっしゃろけど、私やったら手ぇつけまへんわ、えぇ。 手ぇ付けへんちゅうより、手が付けられへんのが本音ですけどな。 あれですわ、各サイズが同等の仕入れ値で、且つ最もロスの少ないサイズの組合せを 求めなさい、と言う数学の問題なら結構面白いんでっしゃろけど... ほな、（おいぼれ弥太郎）
ちょっと考えてはみましたが、やはり、答えが果てしない方向に進んでしまいます。力不足で申し訳ありません。 （ピョン）
３０本の組み合わせを総当たりで考えるのは、プログラムによって自動で出来たとしても かなり難易度が高そうに思います。人力に頼り切った案ではありますが、下記の様な表を作成して、 １本ずつ足したり引いたりを手作業でやりながら最適と思われる組み合わせを考えるというのが 妥当な案ではないかと思います。
３０本全ての長さを足すと13,751mmになるので、４Ｍ×３本と２Ｍ×１本として表の例を作りました。
| A | B | C | D | E | F | G | 1|長さ |必要な本数| 4,000 mm| 4,000 mm| 4,000 mm| 2,000 mm|残りの本数| 2|160 mm| 2 本| | 1 本| 1 本| | | 3|276 mm| 6 本| 6 本| | | | | 4|293 mm| 3 本| 3 本| | | | | 5|360 mm| 4 本| 4 本| | | | | 6|563 mm| 2 本| | 1 本| 1 本| | | 7|610 mm| 3 本| | | | 3 本| | 8|650 mm| 10 本| | 5 本| 5 本| | | 9| | 合計| 3,975 mm| 3,973 mm| 3,973 mm| 1,830 mm| | 10| | 切り幅| 12 mm| 6 mm| 6 mm| 2 mm| | 11| | 使用済| 3,987 mm| 3,979 mm| 3,979 mm| 1,832 mm| | 12| | 使用残| 13 mm| 21 mm| 21 mm| 168 mm| |
・mmや本の単位はセルの表示形式で設定しておくものとします。 ・C9に =SUMPRODUCT($A$2:$A$8,C2:C8) として、D9からF9へコピー ・C10に =SUM(C2:C8)-1 として、D10からF10へコピー ・C11に =SUM(C9:C10) として、D11からF11へコピー ・C12に =C1-C11 として、D12からF12へコピー ・G2に =B2-SUM(C2:F2) として、G3からG8へコピー
・C2からF8欄に本数を手入力して、シミュレーションを行う。（Yosh!）
この場合全て4mのパイプを購入すると、4本あれば足りることになります。 1本目〜3本目については、なるべく余りを少なくすることによって 結果的に4本目の余りが大きくなる（長くなる）わけです。 4本目の余りが大きくなれば、余りから長い部品を取れるようになります。 長い部品の在庫なら、いざという時は切って短い部品を作れます。 逆に短い部品をたくさん作ると、どんどん在庫として残る... 使われない部品を作ってしまうことが1番のロスになります。 私的には650mmをなるべく作っておきたいところですが...
ようは3本の余りをなるべく少なくすることによって、4本目の余りを増やし、 そこから1ランクでも長い部品を1本取れるなら、頑張った甲斐があると思います。
むかしkazuさんが作ったプログラムを少し改良して、 4mから部品を取る組み合わせを出力するようにしてます。 ここから更に4m、3本の組み合わせで余りが一番小さくなるものを 総当りで調べれば望みのプログラムになると思います。 って、それが面倒なんだけど（汗）。 一応そういう形にしようとして、プログラム的に中途半端ですが 気にしないでください。 （ramrun）
表は下記のように入力
A B C D E F G H I 1 10 3 2 4 3 6 2 2 650 610 563 360 293 276 160 4000mm mod
VBAはこんな感じ。
Type Parts
lth As Integer
qty As Integer
cnt As Integer
End Type
Const m_parts As Integer = 7 Const b_parts As Integer = 4000
Sub macro() Dim dat(m_parts) As Parts
For x = 1 To m_parts
If Cells(2, x) = "" Then Exit For
dat(x).lth = Cells(2, x).Value + 1
dat(x).qty = Cells(1, x).Value
dat(x).cnt = Cells(1, x).Value
Next x
r = 3 c = 0
For i = 0 To dat(1).cnt
For j = 0 To dat(2).cnt
For k = 0 To dat(3).cnt
For l = 0 To dat(4).cnt
For m = 0 To dat(5).cnt
For n = 0 To dat(6).cnt
For o = 0 To dat(7).cnt
wans = dat(1).lth * i + dat(2).lth * j + dat(3).lth * k + dat(4).lth * l + dat(5).lth * m + dat(6).lth * n + dat(7).lth * o
If b_parts - wans < 50 Then
If wans < b_parts Then
ActiveSheet.Cells(r, c + 1) = i
ActiveSheet.Cells(r, c + 2) = j
ActiveSheet.Cells(r, c + 3) = k
ActiveSheet.Cells(r, c + 4) = l
ActiveSheet.Cells(r, c + 5) = m
ActiveSheet.Cells(r, c + 6) = n
ActiveSheet.Cells(r, c + 7) = o
ActiveSheet.Cells(r, c + 8) = wans
ActiveSheet.Cells(r, c + 9) = b_parts - wans
r = r + 1
End If
End If
Next o
Next n
Next m
Next l
Next k
Next j
Next i
End Sub
>建築業界の人はこの時勢、多いと思いますが、紙に書いて一つ一つやっているのでし ょうか 材料の付加価値にもよりますけど、現場の職人任せが通例でっしゃろなぁ。但し、この 職人という手合い、とんでもない目利きでして、いちいち紙上で計算せんでもどう切り 合わせたらロスが少のうて済むか見当がつくみたいでっせ、えぇ。オソロシイくらいに
この場合、ロスをどう扱うかによって変わってきますわなぁ。完全なロスは別にして残 りを持ち帰ってストックにするんか、それとも全てロスとして廃棄処分にするんか... （養生をハズしたら製品として成り立たんモンなど） 前者やとオール4mで問題おまへんけど後者やと1m,2mモンも不可欠になってきまっしゃ ろ？
>どうしてそんな風に頭が回るのか 全く同感でス、はい。いっぺん頭ん中覗いてみたいわ。ＩＣがしこたま詰まってまんね で、きっと。
ramrunさんやったらこれ位造作もなく組んでしまう、思うてましたから驚きに値しまへ んことは分かっとってもやっぱし初級者の目には驚異に写りますわ、えぇ。 せやけど、アレ、イエローマークを追いかけるん途中で止めましたわ。時間のかかる事 夥しいもんなぁ。カウントしてみたらなんと55000回も回ってますがな。それをあれだ けのコードでこなしてしまいまんのやから、マクロはエライっ！ で、残念ながら私の教材にはなりまへん。まあ、飾りもんにでもしときまっさぁ。 ほな（おいぼれ弥太郎）
もとはエクセル事務局長が作ったものですので、私的には何も凄くないです（汗）。 一応、4本の組み合わせをシート2へ出力します。 どれが良いかは自分で決めてください（汗）。 きれいにまとめようと思ったけど、面倒なのでスミマセン。
こちらが元。 [[20020510124352]]『エクセルの計算式』（momo） 正直「できましたァ。」には笑いましたァ。
（ramrun）今日はお金にならない残業7時間コース
Type Parts
lth As Integer
qty As Integer
cnt As Integer
End Type
Const m_parts As Integer = 7 Const b_parts As Integer = 4000
Sub macro() Dim dat(m_parts) As Parts
Worksheets(1).Range("a3:i65536").Clear
Worksheets(2).Range("a3:i65536").Clear
For n = 1 To m_parts
dat(n).lth = Cells(2, n).Value + 1
dat(n).qty = Cells(1, n).Value
dat(n).cnt = Cells(1, n).Value
Next n
r = 3: c = 0
For i = 0 To dat(1).qty
For j = 0 To dat(2).qty
For k = 0 To dat(3).qty
For l = 0 To dat(4).qty
For m = 0 To dat(5).qty
For n = 0 To dat(6).qty
For o = 0 To dat(7).qty
wans = _
dat(1).lth * i + dat(2).lth * j + _
dat(3).lth * k + dat(4).lth * l + _
dat(5).lth * m + dat(6).lth * n + _
dat(7).lth * o
If b_parts - wans < 50 Then
With Worksheets(1)
If wans < b_parts Then
.Cells(r, c + 1) = i
.Cells(r, c + 2) = j
.Cells(r, c + 3) = k
.Cells(r, c + 4) = l
.Cells(r, c + 5) = m
.Cells(r, c + 6) = n
.Cells(r, c + 7) = o
.Cells(r, c + 8) = wans
.Cells(r, c + 9) = b_parts - wans
r = r + 1
End If
End With
End If
Next o
Next n
Next m
Next l
Next k
Next j
Next i
With Worksheets(1)
.Range("A3:I65536").Sort Key1:=.Range("I3"), Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
SortMethod:=xlPinYin, DataOption1:=xlSortNormal
End With
ro = 3
For ri = 3 To 65536
If Worksheets(1).Cells(ri, 1).Value = "" Then Exit For
rt = ro
For c = 1 To m_parts
dat(c).cnt = dat(c).qty
Next c
For c = 1 To 9
If c <= m_parts Then
dat(c).cnt = dat(c).cnt - Worksheets(1).Cells(ri, c).Value
End If
Worksheets(2).Cells(ro, c).Value = Worksheets(1).Cells(ri, c).Value
Next c
For rx = 3 To 65536
If Worksheets(1).Cells(rx, 1).Value = "" Then Exit For
If dat(1).cnt >= Worksheets(1).Cells(rx, 1).Value Then
If dat(2).cnt >= Worksheets(1).Cells(rx, 2).Value Then
If dat(3).cnt >= Worksheets(1).Cells(rx, 3).Value Then
If dat(4).cnt >= Worksheets(1).Cells(rx, 4).Value Then
If dat(5).cnt >= Worksheets(1).Cells(rx, 5).Value Then
If dat(6).cnt >= Worksheets(1).Cells(rx, 6).Value Then
If dat(7).cnt >= Worksheets(1).Cells(rx, 7).Value Then
ro = ro + 1
For c = 1 To 9
If c <= m_parts Then
dat(c).cnt = dat(c).cnt - Worksheets(1).Cells(rx, c).Value
End If
Worksheets(2).Cells(ro, c).Value = Worksheets(1).Cells(rx, c).Value
Next c
End If
End If
End If
End If
End If
End If
End If
Next rx
ro = ro + 1
For c = 1 To m_parts
Worksheets(2).Cells(ro, c).Value = dat(c).cnt
Next c
Worksheets(2).Cells(ro, 8).Value = _
dat(1).lth * dat(1).cnt + _
dat(2).lth * dat(2).cnt + _
dat(3).lth * dat(3).cnt + _
dat(4).lth * dat(4).cnt + _
dat(5).lth * dat(5).cnt + _
dat(6).lth * dat(6).cnt + _
dat(7).lth * dat(7).cnt
Worksheets(2).Cells(ro, 9).Value = b_parts - Worksheets(2).Cells(ro, 8).Value
ro = ro + 2
If ro - rt < 5 Then ro = rt
Next ri
End Sub
コレ、コピースルケド、イエローマーク、オワナイ サッキモ ニタヨウナヒト ミツケタ atamaokasii zettai Seijouna sekaini iru Yatarou
ありがとうございます。早速やってみます。まさしく「怪物」ですね。
上に書いてあること、私には何のことだかさっぱりわからないです。
すんごいコードですねぇ。 『解決してくれますよ』 なんて無責任なこと言って、気になってたんですが良かったです。 ありがとうございます。
と、書きましたけど、正直私には理解不可能、当分使い道もないようです。 でも、しっかりとコピペだけはさせて頂き、床の間に飾っておきます。 （jun53）
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.