組合せVBA

質問

環境はExcel2002です

A列に連番数字１から１００が入力されていて
B列の１００行には数字のデータがあるとします

ある目的の数値Xに一番近くなるB列の組合せをC列に表示したいのです…VBAで
B列に表示するのはA列の連番です

『一番近くなる』の意味は２通りあって、両方の算出方法をご教示願います
(1)目的の数値Xを絶対超えないで目的の数値Xに一番近くなる組合せ
(2)目的の数値Xを必ず超えて目的の数値Xに一番近くなる組合せ

回答No.2

web2525 · ベストアンサー

基本的には総当りで計算するしか無い
（2）の条件ならば最大でも9900のループで済むのでさほど問題ではないが
（1）の条件で総当り計算をした場合、最悪一生終わることがない

http://yosshy.sansu.org/P&C.htm
ｎ個のものからｒ個を取り出す取り出し方は
nＣr＝ｎ！／（ｎ－ｒ）！ｒ！

1回めのループ
100この数値から任意の2この数値を取り出す組み合わせ
4950通り

2回めのループ
100この数値から任意の3この数値を取り出す組み合わせ
161700通り
・
・
5回目のループ
100この数値から任意の4この数値を取り出す組み合わせ
3921225
・
・
・
8回目
100この数値から任意の7この数値を取り出す組み合わせ
約160億通り
・
・
・
11回目
100この数値から任意の10この数値を取り出す組み合わせ
1兆7310億通り
・
・
21回目
5垓3600京（こうなるともう数字の単位なんかなんなのか）535983370403810000000通りです

以降51回目のループで最大値
10穰通り　10^29（10の29乗）

よほどうまくアルゴリズムを作成しないと、一般的な個人向けコンピュータの処理能力をはるかに超えています

回答No.6

web2525

色々と考え方が間違ってたので
修正版
組み合わせ最大5個、C7セルに総ループ回数を表示

Sub Macro1()
'---配列準備---
Dim ループ回数 As Long
Dim kisuu As Long
kisuu = Range("B1").Value
Dim hairetu(101), hairetu1(100), hairetu2(100), hairetu3(100), hairetu4(100), syoukei, saidai As Long
For I = 1 To 100
hairetu(I) = Cells(I + 1, 2).Value
hairetu1(I) = Cells(I + 1, 2).Value
hairetu2(I) = Cells(I + 1, 2).Value
hairetu3(I) = Cells(I + 1, 2).Value
hairetu4(I) = Cells(I + 1, 2).Value
Next
hairetu(101) = 0
hairetu1(100) = 0
hairetu2(99) = 0
hairetu3(98) = 0
hairetu4(97) = 0

'---ここからメイン---
saidai = 0
For rupu = 101 To 1 Step -1
For rupu1 = 100 To 1 Step -1
For rupu2 = 99 To 1 Step -1
For rupu3 = 98 To 1 Step -1
For rupu4 = 97 To 1 Step -1

'ここから↓
ループ回数 = ループ回数 + 1

If (rupu <> 100 And rupu = rupu1) Or (rupu <> 99 And rupu = rupu2) Or (rupu <> 98 And rupu = rupu3) Or (rupu <> 97 And rupu = rupu4) Or _
(rupu1 <> 99 And rupu1 = rupu2) Or (rupu1 <> 98 And rupu1 = rupu3) Or (rupu1 <> 97 And rupu1 = rupu4) Or _
(rupu2 <> 98 And rupu2 = rupu3) Or (rupu2 <> 97 And rupu2 = rupu4) Or (rupu3 <> 97 And rupu3 = rupu4) Then
Exit For
End If

syoukei = hairetu(rupu) + hairetu1(rupu1) + hairetu2(rupu2) + hairetu3(rupu3) + hairetu4(rupu4)

If syoukei >= kisuu Or saidai > syoukei Then
Exit For
End If

If saidai < syoukei Then
saidai = syoukei
If rupu <> 101 Then
Range("C1") = rupu
Else
Range("C1") = ""
End If
If rupu1 <> 100 Then
Range("C2") = rupu1
Else
Range("C2") = ""
End If
If rupu2 <> 99 Then
Range("C3") = rupu2
Else
Range("C3") = ""
End If
If rupu3 <> 98 Then
Range("C4") = rupu3
Else
Range("C4") = ""
End If
If rupu4 <> 97 Then
Range("C5") = rupu4
Else
Range("C5") = ""
End If

Range("C7") = ループ回数
End If

If saidai = kisuu - 1 Then
Exit Sub
End If

'ここまで↑
'この部分が本体でループを増やすことで組み合わせ個数を増やせます

Next
Next
Next
Next
Next
End Sub

お礼

何度も丁寧に教えていただきありがとうございます

組み合わせの個数を絞らないと無理なのはよくわかりました
でも、残念ながら組み合わせの個数を絞っては今回の問題を解消できません

せっかく教えていただいて申し訳ありませんでした
でも今回教えていただいたプロシージャから学ぶべきことが多々ありますので
無駄にはしません

回答No.5

web2525

また間違えた
先頭部

Sub Macro1()
'---配列準備---
Dim kisuu As Long
kisuu = Range("B1").Value
Dim hairetu(101), hairetu1(100), hairetu2(100), hairetu3(100), syoukei, saidai As Long

For I = 1 To 50←ここが間違い

修正
For I = 1 To 100

回答No.4

web2525

一応サンプル的なもので組み合わせ個数4個までのマクロを
なるべく余分なループを行わないよう、作ったつもりですが、まだまだ全然工夫が足りない
バブルソートの考え方を取り込めば、組み合わせ個数8個くらいまでは、現実的かもしれませんね

Sub Macro1()
'---配列準備---
Dim kisuu As Long
kisuu = Range("B1").Value
Dim hairetu(101), hairetu1(100), hairetu2(100), hairetu3(100), syoukei, saidai As Long
For I = 1 To 50
hairetu(I) = Cells(I + 1, 2).Value
hairetu1(I) = Cells(I + 1, 2).Value
hairetu2(I) = Cells(I + 1, 2).Value
hairetu3(I) = Cells(I + 1, 2).Value
Next
hairetu(101) = 0
hairetu1(100) = 0
hairetu2(99) = 0
hairetu3(98) = 0

'---ここからメイン---
saidai = 0
For rupu3 = 98 To 1 Step -1
For rupu2 = 99 To 1 Step -1
For rupu1 = 100 To 1 Step -1
For rupu = 101 To 1 Step -1

　’ここから↓

If rupu = rupu1 Or rupu = rupu2 Or rupu = rupu3 Or rupu1 = rupu2 Or rupu1 = rupu3 Or rupu2 = rupu3 Then
Exit For
End If

syoukei = hairetu(rupu) + hairetu1(rupu1) + hairetu2(rupu2) + hairetu3(rupu3)

If syoukei >= kisuu Then
Exit For
End If

If saidai < syoukei Then
saidai = syoukei
If rupu <> 101 Then
Range("C1") = rupu
Else
Range("C1") = ""
End If
If rupu1 <> 100 Then
Range("C2") = rupu1
Else
Range("C2") = ""
End If
If rupu2 <> 99 Then
Range("C3") = rupu2
Else
Range("C3") = ""
End If
If rupu3 <> 98 Then
Range("C4") = rupu3
Else
Range("C4") = ""
End If
End If

If saidai = kisuu - 1 Then
Exit Sub
End If

’ここまで↑
’この部分が本体でループを増やすことで組み合わせ個数を増やせます

Next
Next
Next
Next
End Sub

回答No.3

web2525

5回目以降のループ回数表示が間違っていました

正しくは
3回目のループ
100この数値から任意の4この数値を取り出す組み合わせ
3921225
・
・
・
6回目
100この数値から任意の7この数値を取り出す組み合わせ
約160億通り
・
・
・
9回目
100この数値から任意の10この数値を取り出す組み合わせ
1兆7310億通り
・
・
19回目
5垓3600京（こうなるともう数字の単位なんかなんなのか）535983370403810000000通りです

以降
49回目のループで最大値
10穰通り　10^29（10の29乗）

だからといって、現実的な数値でないことには違いない
組み合わせの最大個数4個くらいで妥協するのが現実的かと思います

お礼

web2525さん丁寧に回答していただいてありがとうございました
確かに気の遠くなる演算となりますね。

大きな数値から順加算し、発生しているＸとの差分を
小さな数値を加算しＸに近い集計をする考えにかえました。

回答No.1

web2525

回答を得るための条件が不足しているようですが

>数値Xに一番近くなるB列の組合せ

B列の複数データの取り出しなのでしょうが、組み合わせとは？
掛け算？足し算？

>B列に表示するのはA列の連番です

B列＝A列という意味？　（1～100までの連番）
連番というのはどういった意味？

>(1)目的の数値Xを絶対超えないで目的の数値Xに一番近くなる

X以下という意味で、それともX未満？

Xの数値は100位上、100以下？
取り出す組み合わせは1つ見つかれば終了、それとも全ての組み合わせ？
B列の組み合わせとは、数値2個の組み合わせ？数値2個以上で上限なし？

極端な話
B列=A列で、X＜100、1つでも組み合わせを見つけたら終了、組み合わせは足し算の場合

（1）は（X-2）と1の組み合わせ
（2）はXと1の組み合わせ

VBAを使う必要もない

補足

大変失礼しました。言葉だけでの質問は今後気をつけます。
(sample)
目的の数値X　1,500,000
A列 　　　　B列 　　　C列　　
1　　　 　　　1,010 　　　　1
2 　　　　　　3,232 　　　　8
3 　　　　　　12,345 　　　　23
↓ 　　　　　　↓ 　　　　　↓
100 　　　987,654

やりたいことが以下の２通りで組み合わせ各々１個でいいです
(1)B列を2個以上組み合わせて加算し、目的の数値Xに一番近い組み合わせをする　X以下
(2)B列を2個組み合わせて加算し、目的の数値Xに一番近い組み合わせをする　X以上

結果をC列に表示してほしい
(1)と(2)を同時に行うことはないです
1個の選択で条件を満たす場合は1個の選択でOKです
よろしくお願いします