[[20101029154929]] 『複数の値からある合計数に一致する組み合わせ』(シン) >>BOT

[ 初めての方へ | 一覧(最新更新順) | 全文検索 | 過去ログ ]

 

『複数の値からある合計数に一致する組み合わせ』(シン)
XP エクセル2003

500という合計値があり、現在20通りぐらいのランダムな値のなかで何れかの組み合わせで合計500になる組み合わせをもとめたい。


 新規ブックにて試してください。

 標準モジュール(Module1)に

 '=================================================================
 Option Explicit
 Private svarray() As Variant
 Private ccomb As Long
 '=================================================================
 Sub open_comb(myarray As Variant)
 '組合せ処理のオ−プン
 'myarray    組合せを行う配列
    Dim ele As Variant
    Dim g0 As Long
    g0 = 0
    Erase svarray()
    For Each ele In myarray
       ReDim Preserve svarray(1 To g0 + 1)
       svarray(g0 + 1) = ele
       g0 = g0 + 1
    Next
    ccomb = 0
 End Sub
 '================================================================= 
 Function get_comb(Optional flg As Long = 0) As Variant
 '組合せリストを取り出す 
 'flg 0 次のデータ 1 桁スキップ
 'get_comb 組合せの配列 Falseは、データの終わり
    Dim g0 As Long
    Dim g1 As Long
    Dim ret As Boolean
    Dim ans() As Variant
    Dim oncnt As Long
    ret = False
    If flg = 0 Then
       ccomb = ccomb + 1
       If ccomb < (2 ^ UBound(svarray())) Then
          ret = True
       End If
    ElseIf flg = 1 Then
       oncnt = 0
       For g0 = 0 To UBound(svarray()) - 1
          If ccomb And 2 ^ g0 Then
             oncnt = oncnt + 1
             ccomb = ccomb And (Not 2 ^ g0)
          Else
             If oncnt >= 2 Then
                ccomb = ccomb Or 2 ^ g0
                ret = True
                Exit For
             End If
          End If
       Next
    End If
    If ret = True Then
       g1 = 0
       For g0 = 0 To UBound(svarray()) - 1
          If ccomb And 2 ^ g0 Then
             ReDim Preserve ans(1 To g1 + 1)
             ans(g1 + 1) = svarray(g0 + 1)
             g1 = g1 + 1
           End If
       Next
       get_comb = ans()
       Erase ans()
    Else
       get_comb = False
    End If
 End Function
 '=================================================================
 Sub close_comb()
 '組合せ処理のクローズ
   Erase svarray()
   ccomb = 0
 End Sub

 別の標準モジュール(Module2)に

 '=================================================================
 Sub sample1()
    Dim fit As Variant
    Dim rw As Long
    Dim mem As Variant
    Dim flg As Long
    Dim rng As Range
    Set rng = Range("a1:a20")
    With rng
       .Formula = "=int(rand()*300)+1"
       .Value = .Value
       .Sort Key1:=Range("A1"), Order1:=xlAscending, Header:=xlGuess, _
           OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
           :=xlPinYin, DataOption1:=xlSortNormal
    End With
    DoEvents
    Range("e:e").Clear
    fit = Application.InputBox("合計値を入力して", , , , , , , 2)
    If TypeName(fit) <> "Boolean" Then
       Call open_comb(rng.Value)
       flg = 0
       mem = get_comb(flg)
       Do Until TypeName(mem) = "Boolean"
          flg = 0
          If Application.Sum(mem) = Val(fit) Then
             Cells(rw + 1, 5).Value = Join(mem, "\")
             rw = rw + 1
          ElseIf Application.Sum(mem) > Val(fit) Then
             flg = 1
          End If
          mem = get_comb(flg)
       Loop
       Call close_comb
    End If
    Set rng = Nothing
 End Sub
 
 としてSample1を実行してください。

 A1:A20にランダムな数値が表示されます。
 求める合計値を入力してください。
 A1:A20の数値で、その合計値になる組合せをE列に表示します。
 結果は、¥ 文字で区切られています。

 試してみてください。

 これでうまくいくようなら、ご自分の仕様に合わせて、
 Module1を使って見みてください。標本数が30件までは使えます。

 標本であるA1:A20は、昇順に整列されている必要があります

 ichinose


回答ありがとうございます。

とりあえず、頑張ってみます。


 他掲示板ですが、参考になるかもしれません。
 http://oshiete.goo.ne.jp/qa/5212312.html

 他にもこの種の問題は過去に多くの相談例が
 ありますので検索されたらよいでしょう。

 shibaraku

 こんにちは
 よく質問に出るナップサック問題ですネ。ネットで調べるとよく分かるかと思います。
 データ数20個の総組合せ数1,048,575、データ数30個の総組合せ数1,073,741,823となり、データ数を増やすと組合せ数は爆発的なかんじで増えます。

 ナップサック問題をエクセルの機能で行うには、ソルバーを使用しますが、バージョン等によりデータ数の取扱数が変わります。
 (PC本体のCPU及びソフトの性能向上等が関係すると思料します。)
 Windos XP Excel2003の場合データ数20個(総組合せ数1,048,575)で約40秒かかり、データ数21個 (総組合せ数2,097,151)では2分以上かかり、かつ、解が出ない場合がある。
 Windos Vista  Excel2007 ソルバーを使用して、下記の35個データで値を求めてみました
 データ数35個(総組合せ数34,359,738,367)で値「500」を求めた。約11秒程度
  =A1+A6+A7+A8+A9+A15+A18+A23+A26+A28+A32
 データ数35個(総組合せ数34,359,738,367)で値「400」を求めた。約9秒程度
  =A6+A8+A9+A11+A13+A22+A23+A24+A27+A29+A35
 データ数35個(総組合せ数34,359,738,367)で値「300」を求めた。約9秒程度
  =A13+A14+A15+A17+A18+A23+A27+A28+A29+A35

 (Windos 7 Excel2007は、Windos Vista  Excel2007より1〜2秒程度早い感じ?)

 A1〜A35までのデータです。(参考)
 17
 20
 33
 43
 50
 55
 58
 60
 73
 24
 35
 15
 10
 40
 28
 36
 42
 53
 38
 19
 21
 27
 38
 41
 29
 64
 10
 28
 37
 31
 30
 26
 18
 44
 14

 ソルバーを使用する方法
 B列空白
 C1セルに=SUMPRODUCT(A1:A35,B1:B35)
 「ソルバー:パラメータ設定」ダイアログボックス
 目的セル:「C1」
 目標値:「値」にレ点を入れる、右側の枡に検索する値を入力。例では500なので枡に500と入力
 変化させるセル:B1:B35
 「制約条件」の「追加」ボタンをクリックする。「制約条件の追加」ダイアログボックスが表示される。
 「制約条件の追加」ダイアログボックスの"セル参照"に「B1:B35」と入力
 「制約条件の追加」ダイアログボックスに表示される"セル参照"のウィンドウの「<=」の記号の右の▼をクリックし、「データ」を選ぶ。
 「制約条件の追加」ダイアログボックスの"制約条件"に、「バイナリ」が自動的に入ります。
 「追加」ボタンを押し、次に「キャンセル」ボタンを押します。
 「ソルバー:パラメータ設定」ダイアログボックスの実行ボタンを押します。
 参考に実施してみてください。XPでしたらデータ数は20個まででお願いします。

 (atiboh)

コメント返信:

[ 一覧(最新更新順) ]


YukiWiki 1.6.7 Copyright (C) 2000,2001 by Hiroshi Yuki. Modified by kazu.