エクセル・解がある数字になるように足し算する数字を選ぶ方法

質問

いくつかの数字が並んでいて、その中から選んで足し算をします。
その足し算の答えがある範囲内に当てはまるような組み合わせを全部求めたいと思います。

分かりにくいので具体例を書きます。
0.5
1.1
1.8
2.3
3.8
4.2

上記の６個の数字からいくつか選んで足した結果が4.9～5.9になる組み合わせをすべて求めたいです。
この場合、
0.5+1.1+1.8+2.3＝5.7
1.1+1.8+2.3＝5.2
4.2+0.5＝4.7
4.2+1.1＝5.3
4.2+1.1+0.5＝5.8
3.8+1.8＝5.6
3.8+1.1＝4.9
3.8+1.1+0.5＝5.4
の８種類（もっとあったらごめんなさい）になると思います。
この８種類を書き出したいのですが、うまい方法が思い浮かびません。

ソルバーとかなのかと思って調べてみたのですが、計算式が確定していない場合は使えないみたいです。
やっぱりＶＢＡを使わないと難しいでしょうか？

なんとか簡単にできる方法があれば、アドバイス下さい。
よろしくお願いいたします。

回答No.4

NNAQ

数個なら。。。

A列にデータがあって、作業列が X～Z列だとして、
　　　X　　　Y　　　Z
1　　　　　　　　　　001010
2　000001　 4.2　　010001
3　000010　 3.8　　010010
4　000011　 8　　　011100
5　000100　 2.3　　110001
6　000101　 6.5　　110010
7　000110　 6.1　　111100
：
X2=TEXT(DEC2BIN(ROW(A1)),REPT("0",6))
X64までコピー(64=2^6)。
Y2=SUMPRODUCT($A$1:$A$6,MID(X2,ROW($A$1:$A$6),1)*1)
Y64までコピー。

Y列にオートフィルターで　[4.9以上]AND[5.9以下]　の条件で抽出。
抽出されたX列のデータをコピー、Z1に[形式を選択して貼り付け]-[値]。

　　A　　　B　　C　　・・・
1　0.5　　0　　0
2　1.1　 0　　1
3　1.8　 1　　0
4　2.3　 0　　0
5　3.8　 1　　0
6　4.2　 0　　1
7　　　　5.6　　5.3

B1=MID(INDEX($Z:$Z,COLUMN(A1)),ROW(A1),1)*1
B6までと、右へコピー。
B7=SUMPRODUCT($A1:$A6,B1:B6)
右へコピー。

1と0 で、その数字を使う使わない の判定にします。7行目は確認用。
B列は　1.8 + 3.8 = 5.6
C列は　1.1 + 4.2 = 5.3
という意味です。

VBA でやるなら、２つ足す場合、３つ足す場合、４つ足す場合・・・
と、やると、遅くなると思います。
総当りはどんな方法でも限界があるでしょうけど。

'データは、A1セルから空白無く、複数あるとする
Sub SoAtari()
　'目標値
　Const a As Currency = 4.9 '以上
　Const z As Currency = 5.9 '以下

　Dim n As Integer 'データ数
　Dim arr0, arr1() As Currency
　Dim b As Long
　Dim i As Long, j As Long 'ループ用、使い回し
　Dim col As Integer '列番号

　With Range("a1")
　　n = .End(xlDown).Row
　　arr0 = .Resize(n).Value
　　.CurrentRegion.Offset(, 1).ClearContents
　End With

　'全ての組み合わせの和を配列arr1にセット
　'全て計算する必要は無いので、改善の余地あり
　ReDim arr1(1 To 2 ^ n - 1)
　For i = 0 To n - 1
　　b = 2 ^ i
　　arr1(b) = CCur(arr0(i + 1, 1))
　　For j = 1 To b - 1
　　　arr1(b + j) = arr1(b) + arr1(j)
　　Next j
　Next i

　col = 2
　For i = 1 To 2 ^ n - 1
　　'目標値の範囲ならシートへ書き込む
　　If arr1(i) >= a And arr1(i) <= z Then
　　　For j = 0 To n - 1
　　　　If i And 2 ^ j Then Cells(j + 1, col).Value = arr0(j + 1, 1)
　　　Next j
　　　Cells(n + 1, col).Value = CDbl(arr1(i))
　　　col = col + 1
　　End If
　Next i

　Erase arr0, arr1
End Sub

お礼

ありがとうございます！
すごい！！関数でもできるんですね。
０と１を使って使うかどうかの判定をしたり、それを組み合わせで全通り表示する方法など、たぶん一生考えても思いつけそうにありません。
感動しました（Ｔ－Ｔ）
９個まではちゃんとできました！
１０個からは２進数が表示されないみたいでエラーになってしまいました。

ＶＢＡの改善とは、上限を超えた場合は計算をしなくても良いということですよね。
でも、試しに動かしてみたら速度に問題なく計算できました！！
結果が一覧になっていてとても見やすかったです。
とてもとても勉強になりました。
やはり配列はちゃんと勉強すればとても役立つのだと思いました。
ありがとうございました！！大感謝です。