[[20210516175244]]　『指定した数字に近い組合せ』（影猫）　ページの最後に飛ぶ

『指定した数字に近い組合せ』（影猫）

よろしくお願いいたします。

4000という数字を基準として、

A列に、
3000
582
675
2654
863
79

など、ランダムな数字が並んでる中から、
基準の4000に近い数字になるように
組み合わせを表示できるようにしたいのですが
可能でしょうか？

よろしくお願いいたします。

＜使用 Excel：Excel2019、使用 OS：Windows10 ＞

4000以上の数字はあるのだろうか。
（なな） 2021/05/16(日) 19:10

4000以上の数字はないです！
すべて4000以下の数字です。
よろしくお願いいたします。
（影猫） 2021/05/16(日) 19:12

[[20210516171150]]
と同じ話ですよね。

遅くなったケースと、まったく同一の数値を示した方が有益じゃないですか？

・目的変数とその制約
・独立変数にかけている条件
・３つある手法のうち採用している手法
を示してもらって共通の前提のうえで検証したらどうですか？

（γ） 2021/05/16(日) 19:23

すみません、リンクと同じです❗
昨日までサクサクだったのに、
今日はめちゃくちゃ重くなってしまいました。
特になにもいじってないのですが…。

初心者なもので、ググってもわからなくて、
友達から関数でやった方がいいのではと
アドバイスいただいたので、
質問させていただきました！
（影猫） 2021/05/16(日) 19:36

私が申し上げたのは、架空の数値じゃなく、
遅くなったというそのケースの、データ（複数の数値）をきちんと示してください、
ということですが。
伝わりませんか？
（γ） 2021/05/16(日) 19:50

すみません！

現状

C1　SUMPRODUCT(A1:A13,B1:HB13)

A B
2534 1
3264 1
112 1
457 1
264 1
546 1
. .
. .
. .

と入力しています。

ソルバー内に
目的のセル　C1
目標値　　　最大値
変数セルの変更　$A$1:$A$13
制約条件の対象　$A1$A13 = バイナリ
　　　　　　　　C1 <= 4000

という入力をしています。

申し訳ありません、
宜しくお願い致します。

（影猫） 2021/05/16(日) 20:08

AとBが近くて読みにくくなってました。

A
2534
3264
112
457
264
546

Bはすべて1を入力しています。
（影猫） 2021/05/16(日) 20:09

546 1
. .
. .
. .
ここを省略したら意味ないです。
これにてROMに回ります。通じないようなので。
（γ） 2021/05/16(日) 20:11

すみません。

数字は4000以下でどんな数字でもよかったので
省略した方が見やすいかなと思いました。

2534
3264
112
457
264
546
1125
545
1789
2565
3800
1985
3302

です。
今一度、よろしくお願いいたします。
（影猫） 2021/05/16(日) 20:31

 こんばんは！
ソールバーがなぜ？遅くなったのかはわかりませんが、、、例のnCr関数です。。。
では、、では、、

 3985	 =3264+457+264
3960	 =112+546+3302
3959	 =112+545+3302
3954	 =264+1125+2565
3944	 =112+457+264+546+2565
3943	 =112+457+264+1125+1985
3943	 =112+457+264+545+2565
3923	 =2534+264+1125
3922	 =3264+112+546
3921	 =3264+112+545
3920	 =264+546+1125+1985
3920	 =264+546+545+2565
3919	 =264+1125+545+1985
3917	 =457+546+1125+1789
3916	 =457+1125+545+1789
3913	 =2534+112+457+264+546
3912	 =112+3800
3912	 =2534+112+457+264+545
3909	 =112+457+264+546+545+1985
3889	 =2534+264+546+545
以下割愛です。

 Option Explicit
Sub てすと()
Dim x As Variant
Dim v As Variant
Dim n As Long
Dim r As Long
Dim k As Long
Dim MyTimer As Single
MyTimer = Timer
With Sheets("Sheet1")
    x = .Range("A1", .Range("A" & Rows.Count).End(xlUp)).Value
End With
n = UBound(x, 1)
r = UBound(x, 1) - 1
ReDim v(1 To Application.Combina(n, r), 1 To 2)
MynCr n, r, "", x, v, k
QuickSort v, 1, LBound(v, 1), UBound(v, 1)
With Sheets("Sheet2")
    .Cells.Clear
    .Range("A1").Resize(k, UBound(v, 2)).Value = v
End With
Erase x, v
MsgBox Format(Timer - MyTimer, "###0.000")
End Sub
Function MynCr(ByVal n As Long, ByVal r As Long, ByVal txt As String, ByVal x As Variant, ByRef v As Variant, ByRef k As Long)
Dim ix As Long
If r = 0 Then
Else
    For ix = 1 To n
        MynCr ix - 1, r - 1, "+" & x(ix, 1) & txt, x, v, k
    Next
End If
If txt <> "" Then
    If Evaluate("=" & Mid$(txt, 2)) < 4000 Then
        k = k + 1
        v(k, 1) = Evaluate("=" & Mid$(txt, 2))
        v(k, 2) = " =" & Mid$(txt, 2)
    End If
End If
End Function
Private Sub QuickSort(MySAry As Variant, ByVal MySKey As Long, ByVal MySLeft As Long, ByVal MySRight As Long)
Dim MySMid As Double
Dim i As Long, j As Long, n As Long
Dim MySLBound As Long, MySUBound As Long
Dim MyStmp As Variant
MySLBound = LBound(MySAry, 2)
MySUBound = UBound(MySAry, 2)
MySMid = MySAry((MySLeft + MySRight) \ 2, MySKey)
i = MySLeft
j = MySRight
    Do
        Do While MySAry(i, MySKey) > MySMid
            i = i + 1
        Loop
        Do While MySAry(j, MySKey) < MySMid
            j = j - 1
        Loop
        If i >= j Then Exit Do
        For n = MySLBound To MySUBound
            MyStmp = MySAry(i, n)
            MySAry(i, n) = MySAry(j, n)
            MySAry(j, n) = MyStmp
        Next
        i = i + 1
        j = j - 1
    Loop
If MySLeft < i - 1 Then QuickSort MySAry, MySKey, MySLeft, i - 1
If MySRight > j + 1 Then QuickSort MySAry, MySKey, j + 1, MySRight
End Sub
（SoulMan） 2021/05/16(日) 21:57

Soulmanさん、ありがとうございます！
やってみます！
本当にありがとうございます！
（影猫） 2021/05/18(火) 21:52

コメント返信：

[ 一覧(最新更新順) ]

[[20210516175244]] 『指定した数字に近い組合せ』（影猫） ページの最後に飛ぶ

[[20210516175244]]　『指定した数字に近い組合せ』（影猫）　ページの最後に飛ぶ