[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]
『組み合わせ、組み合わせの合計で抽出』（マイルドセブン）
第１群 1 2 3 4 5 9 第２群 5 6 7 8 13 15 16 第３群 10 11 13 15 第４群 13 15 16 18 19 21 第５群 23 27 29 31 32 34 35 第６群 46 47 53 54 55 59
各群から１つずつ数値を抽出した場合に、合計数が 120 になる組み合わせを抽出したい場合は、どのようにエクセル上で操作したらいいですか？
色々調べてみたものの、同じようなケースの質問がなかったので、投稿させていただきました。 どうか、宜しくお願い致します。
以前、 [[20080501151223]]
で似たようなご質問（この時、結果投稿がないので適当なコードだったかは不明） に投稿したことがあります。
もうちょっとだけ、ご質問に近い例題に変更すると・・・、 新規ブックの標準モジュール（Module1）に
'===================================================================
Sub main()
Dim idx As Long
Dim g0 As Long
Dim wk As Variant
Dim ans() As Variant
' ↑組み合わせメンバーを取得する配列
Dim rng As Range
' ↑組み合わせセル範囲
Call サンプル作成
Set rng = Range("a1").CurrentRegion
Call ttlhit_init(rng.Columns.Count)
For g0 = 1 To rng.Columns.Count
With rng.Cells(1, g0)
Call ttlhit_add(Range(Cells(1, .Column), Cells(Rows.Count, .Column).End(xlUp)))
End With
Next
idx = 10
ReDim ans(1 To rng.Columns.Count)
Do While ttlhit_get(ans()) = 0
Cells(idx, 1).Value = Join(ans(), "-")
idx = idx + 1
Loop
MsgBox "以上" & idx - 10 & "通り"
Call ttlhit_term
End Sub
'=======================================================================
Sub サンプル作成()
Const l As Long = 100
Cells.ClearContents
Range("a1:d1").Value = Array(rd(l), rd(l), rd(l), rd(l))
Range("a2:d2").Value = Array(rd(l), rd(l), rd(l), rd(l))
Range("a3:d3").Value = Array(rd(l), rd(l), rd(l), rd(l))
Range("d4:d6").Value = Application.Transpose(Array(rd(l), rd(l), rd(l)))
MsgBox "サンプル作成 セルＡ１０から処理を開始します"
End Sub
'=========================================================================
Function rd(lim As Long) As Long
'適当な数字を生成する
rd = Int(Rnd * lim) + 1
End Function
別の標準モジュール（Module2）に
'=================================================================
Private ttl_rng() As Range
Private ttl_idx() As Long
Private ttl_a_num As Long
'===================================================================
Sub ttlhit_init(hitnum As Long)
'組合せ処理の開始宣言
'input : hitnum 抜き取り数
Dim g0 As Long
Erase ttl_rng()
Erase ttl_idx()
ReDim ttl_rng(1 To hitnum)
ReDim ttl_idx(1 To hitnum)
For g0 = LBound(ttl_idx()) To UBound(ttl_idx())
ttl_idx(g0) = 1
Next
ttl_idx(UBound(ttl_idx())) = 0
ttl_a_num = 0
End Sub
Sub ttlhit_add(rng As Range)
'組合せ標本セル範囲の登録
'input : rng 連続したセル範囲
Set ttl_rng(ttl_a_num + 1) = rng
ttl_a_num = ttl_a_num + 1
End Sub
'======================================================================
Function ttlhit_get(ans()) As Long
'組み合わせメンバーを配列に出力する
'output: ans() メンバの配列
' ttlhit_get:0 -- 正常に配列取得
' 1 -- メンバの終わり
Dim g0 As Long
ttlhit_get = 1
For g0 = UBound(ttl_idx()) To LBound(ttl_idx()) Step -1
If ttl_idx(g0) + 1 <= ttl_rng(g0).Count Then
ttl_idx(g0) = ttl_idx(g0) + 1
ttlhit_get = 0
Exit For
Else
ttl_idx(g0) = 1
End If
Next
If ttlhit_get = 0 Then
For g0 = LBound(ttl_idx()) To UBound(ttl_idx())
ans(g0) = ttl_rng(g0).Cells(ttl_idx(g0)).Value
Next
End If
End Function
'=======================================================================
Sub ttlhit_term()
'組合せ処理の終了
Erase ttl_rng()
Erase ttl_idx()
ttl_a_num = 0
End Sub
上記のmainを実行すれば、表示されたサンプルデータに対して (1群から4群、つまり、Ａ列からＤ列中から、一つずつ数字を取り出す組合せ）が、 A10から表示されます。よって、組合せリストの合計が120になるものを抜粋すればよいのですが。
上記のModule2の内容を理解し工夫して使えば、この問題の結果は、得ることができます。
これは、群に分けられたデータから（実際は数字でなくても良い）一つずつ取り出すデータの組合せリストを全て取得するツールです。
これを使えば時間はかかっても答えの取得はできます。
時間短縮は、よく言われる組合せの最適化という手法です。
つまり、全てのリストを取得しなくても答えをだす工夫が必要ですが、 それは、考えてみてください。
ichinose
実行してみたのですが、第１〜６群の数字が表示されません。
私が初心者なのもありますが、どこかにその数字を入れなきゃいけなかったのでしょうか？
わがままで甘えかもしれませんが、詳しく教えて頂けたら幸いです。
ちなみに、組み合わせ数字は１セルに６コ入るより、各行か各列に１つずつ入る方が
あとで合計数を抽出する際に簡単かな、とも思ったのですが、できますでしょうか？
やはり、全部を１度に抽出するのは難しいでしょうか？
教えてもらう立場なのに、申し訳ありませんが、宜しくお願い致します。
（マイルドセブン）
まず、私は、そのまま使えるコードを提示することは ここのところは控えています。
必ず、マイルドセブンさんにも考えていただきます。 もっとも、他の投稿者の方がそのまま使えるコードを提示されるのは、自由ですが。
>実行してみたのですが、第１〜６群の数字が表示されません。 前回投稿で記述したように >上記のmainを実行すれば、表示されたサンプルデータに対して >(1群から4群、つまり、Ａ列からＤ列中から、一つずつ数字を取り出す組合せ）が、 >A10から表示されます。
これがプロシジャーmainの機能です。
よって、第１〜４群の数字がサンプルデータとして表示されていますね？ その後、第１〜４群の数字を一つずつ取り出す組合せリストがA10から表示されたはずです。
これでModule2に記述したプロシジャー群を使えば、 グループ分けしたデータ群から一つずつ取り出す組合せリストが取得できることが わかったかと思います。これを使えば、例題では、1群から4群の組合せリストを 全て表示する機能でしたが、第１〜６群の数字から一つずつ 取り出す組合せリストの合計値が120になるリストも表示できると思います。 それは、mainというプロシジャーを少し変更することで可能になります。
それは、マイルドセブンさんが考えてください。
因みに
サンプル作成というプロシジャーを以下に変更後に
Sub サンプル作成()
Const l As Long = 100
Cells.ClearContents
Range("a1:f1").Value = Array(rd(l), rd(l), rd(l), rd(l), rd(l), rd(l))
Range("a2:f2").Value = Array(rd(l), rd(l), rd(l), rd(l), rd(l), rd(l))
Range("a3:f3").Value = Array(rd(l), rd(l), rd(l), rd(l), rd(l), rd(l))
Range("f4:f6").Value = Application.Transpose(Array(rd(l), rd(l), rd(l)))
MsgBox "サンプル作成 セルＡ１０から処理を開始します"
End Sub
mainを実行すれば、 １群から６群のサンプルデータが表示され、そのデータを基に組合せリストが 表示されます。
こっちの方が考えやすいですか？
>ちなみに、組み合わせ数字は１セルに６コ入るより、 >各行か各列に１つずつ入る方があとで合計数を抽出する際に簡単かな、 >とも思ったのですが、できますでしょうか？
コードをよく調べれば、分かりますが、 組合せリストは、ans()という配列変数に格納されます。
よって、数字毎、別のセルに格納しやすいようにしてあります。 ここでも マイルドセブンさんに考えていただくために 敢えて、わざと "-"を区切り文字にして、一つのセルにいれました。
これもmainのコードをよく調べていただければ、分かると思います。
それでも分からなければ、今度は、ピンポイントで質問してください。
作ってほしいのであって、 VBAを勉強するつもりがないのであれば（考え方はそれぞれですから)、 私からの投稿はこれで終わりです。
ichinose
この問題を解くのは結構面倒ですね。 Excelソルバーで解く方法もあります。 ただ通常のソルバーの設定より少し面倒です。 あまり見かけない問題なので当方のブログで話題にさせて いただきました。
http://mathinfo.blog.fc2.com/
もし興味があればご覧ください。 ソルバーを使う機会が少ないと設定で分からないところが あるかもしれません。 ブログの方で質問していただければと思います。
この掲示板で回答しようかとも思いましたが、画像の添付 ができるのかどうか分からないのでそのままになってます。
(varum)
データ数が多いと難しくなります。また直接答えを求めるものではありませんが。 各群の 最小値 最大値 1 1 9 2 5 16 3 10 15 4 13 21 5 23 35 6 46 59 合計 98 155 各群から１つずつ選んで得られる合計は 98〜155の範囲です。 各群の数値-(群の最小値) 1 0 1 2 3 4 8 2 0 1 2 3 8 10 11 3 0 1 3 5 4 0 2 3 5 6 8 5 0 4 6 8 9 11 12 6 0 1 7 8 9 13 合計が99 の組合せ (最小値の合計)+1 は 上記の "1" のものを選べばいいことになります。４通り。その他の場合も同様に考えられます。 (NB)
1 1 1 1 1 1
5 5 5 5 5 5
10 10 10 10 10 10
13 15 15 16 16 16
32 34 35 29 34 35
59 55 54 59 54 53
計 120 120 120 120 120 120
合計１２０となる組合せ総数 1568
すべての組合せ 1568件を列挙するのでしょうか。 (NB)
各群から１つずつ数値を選んだ場合の組合せの総数は 6*7*4*6*7*6=42336 42,336通りとなります。 また各組合せの数値の合計はすべて 最小98 〜 最大155の範囲に収まります。 155-98+1 = 58 組合せが42,336通りあってもその取ることのできる数値は 58通りしかありません。 ある合計値に該当する組合せの数は平均で 42,336÷58=730 730通り。 また合計の最小値、最大値は各１つずつ、最小値＋１、最大値−１は６以下と上下の端の方は少なくなりますので、中央付近合計が120,・・125,・・130 では1500通り以上あります。 1500通りの組合せを列挙するのも面倒で無意味ですし、またこの「1500通り」もただ「沢山ある」というだけです。 質問者が提示されたデータは「簡略化した例」で、本当のデータ、本当にやりたいことを提示されれば回答が出来るかも知れません。 (NB)
合計値 98〜155 を実現するための「数値」の数 第１群 1 3 5 9 第２群 5 6 15 16 第３群 10 13 15 第４群 13 21 第５群 23 35 第６群 46 59 (NB)
計算方法が見つからなかったら、すべての組み合わせを計算すればよいだけ、
幸い質問の組み合わせは4万程度なので、順次計算させれば、結果は得られます。
プログラミング?もしくは計算手法のご質問なら的外れですが、
大して難しいことをしなくても結果は得られます。 (Hatch)
Sub test()
Dim x1, x2, x3, x4, x5, x6
Dim y1, y2, y3, y4, y5, y6
Dim i1, i2, i3, i4, i5, i6
Dim z1, z2
x1 = Range("B1:G1").Value
x2 = Range("B2:H2").Value
x3 = Range("B3:E3").Value
x4 = Range("B4:G4").Value
x5 = Range("B5:H5").Value
x6 = Range("B6:G6").Value
For i1 = 1 To UBound(x1, 2)
For i2 = 1 To UBound(x2, 2)
For i3 = 1 To UBound(x3, 2)
For i4 = 1 To UBound(x4, 2)
For i5 = 1 To UBound(x5, 2)
For i6 = 1 To UBound(x6, 2)
z1 = x1(1, i1) + x2(1, i2) + x3(1, i3) + x4(1, i4) + x5(1, i5) + x6(1, i6)
If z1 = 120 Then
z2 = z2 + 1
Cells(z2 + 10, 1).Value = z2
Cells(z2 + 10, 2).Value = x1(1, i1)
Cells(z2 + 10, 3).Value = x2(1, i2)
Cells(z2 + 10, 4).Value = x3(1, i3)
Cells(z2 + 10, 5).Value = x4(1, i4)
Cells(z2 + 10, 6).Value = x5(1, i5)
Cells(z2 + 10, 7).Value = x6(1, i6)
End If
Next i6
Next i5
Next i4
Next i3
Next i2
Next i1
End Sub
[ 一覧(最新更新順) ]
YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki.
Modified by kazu.