[[20210420122941]]　『最大公約数　組合せの自動計算』（お願いします）　ページの最後に飛ぶ

『最大公約数　組合せの自動計算』（お願いします）

a1に例として5,000という値(ここには任意の数字が入れられるようにします)

a2に例として350という値(ここにも任意の数字が入れられるようにします)

a3に例として280という値(ここにも任意の数字が入れられるようにします

以上の条件下で
5,000以内(5,001になってはダメ)で
350と280の組合せでの最大となるものを
a4とa5に出したいのですが。

この場合
a4は11という値が出るように。(350×11=3,850)
a5は4という値が出るように。(280×4=1,120)
(3,850+1,120=4,970)

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

 A4セル:7
 A5セル:9
 とか
 A4セル:3
 A5セル:14
 でも4970になるが最大になる組み合わせが複数ある場合にはどうしたいのだろうか？
（ねむねむ） 2021/04/20(火) 12:46

出来れば
上記組合せの他の候補も表示できるように

a6に7(350×7=2,450)
a7に9(280×9=2,520)
(2,450+2,520=4,970)

a8に3(350×3=1,050)
a9に14(280×14=3,920)
(1,50+3,920=4,970)

（お願いします） 2021/04/20(火) 12:49

a4～a9に入れるべき数式が知りたいです。

（お願いします） 2021/04/20(火) 12:50

6セルだけでやるのは無理じゃない？
できたとしても相当長い数式になりそうだけど
別シートに総当りする表を作ってそっちから数値以下の最大値を探して
その行列番号とかを出力するとか
（砂糖） 2021/04/20(火) 13:22

あとこの質問は最大公約数関係ないですよね

（砂糖） 2021/04/20(火) 13:24

Sub main()

    Dim a1, a2, a3, a4, a5, mx, i As Long, j As Long
    a1 = Range("A1").Value
    a2 = Range("A2").Value
    a3 = Range("A3").Value
    For i = 0 To Int(5000 / (WorksheetFunction.Min(a2, a3)))
        For j = 0 To Int(5000 / (WorksheetFunction.Min(a2, a3)))
            If i * a2 + j * a3 <= a1 And i * a2 + j * a3 >= mx Then
            a4 = i: a5 = j: mx = i * a2 + j * a3
            End If
        Next j
    Next i
    Range("A4").Value = a4
    Range("A5").Value = a5
End Sub
（mm） 2021/04/20(火) 13:27

350と280の最大公約数が70で
5000未満になる最大数が70*71＝4970で
合わせて71になる4の倍数(70*4＝280)と5の倍数(70*5=350)
4X+5Y=71のX,Y整数同士の組み合わせを見つける
（Ｓ） 2021/04/20(火) 13:35

ありがとうございます。
（Ｓ）様のマクロで出来ました。
（お願いします） 2021/04/20(火) 13:57

最大公約数から求める計算があるんですね
勉強になりました
（砂糖） 2021/04/20(火) 14:07

 こんばんは！
例のnCr関数で出来ないかなと書き始めたものの。。。途中で？？？です。(^^;
取り敢えず、、、
Sheet2に↓こんな答えが出ました。。。
後は、応用してください。。。(おぉぉぉいいい）
わちきはもう寝ます。
おやすみなさいzzzzzzzzzzzzzzzzz

 350+350+350+350+350+350+350+350+350+350+350+280+280+280+280	　　　　4970
350+350+350+350+350+350+350+280+280+280+280+280+280+280+280+280	　　　　4970
350+350+350+280+280+280+280+280+280+280+280+280+280+280+280+280+280	4970

 Option Explicit
Sub てすと()
Dim MyA As Variant
Dim MyAry As Variant
Dim MyMax As Double
Dim MyT As Double
Dim 最大値 As Double
Dim k As Long
With Sheets("Sheet1")
    MyT = .Range(" A1").Value
    MyA = .Range("A2:A3").Value
    MyMax = MyT \ Application.Max(MyA(1, 1), MyA(2, 1))
End With
MyAry = Application.Transpose(Array(MyA(1, 1), MyA(2, 1), "結果"))
If 200 < MyMax Then
    With Sheets("Sheet2")
        .Cells.Clear
        .Range("A1").Resize(UBound(MyAry, 2), UBound(MyAry, 1)).Value = Application.Transpose(MyAry)
    End With
    MsgBox "上限を超えました"
    Exit Sub
End If
MynCr UBound(MyA, 1), MyMax, "", MyA, 0, MyAry, 最大値, k
With Sheets("Sheet2")
    .Cells.Clear
    .Range("A1").Resize(UBound(MyAry, 2), UBound(MyAry, 1)).Value = Application.Transpose(MyAry)
End With
Erase MyA, MyAry
End Sub
Sub MynCr(ByVal xi As Long, ByVal xn As Long, ByVal txt As String, ByVal x As Variant, ByVal z As Double, ByRef v As Variant, ByRef 最大値 As Double, ByRef k As Long)
Dim w As Variant
Dim i As Long
    k = k + 1
    If k > 2000 Then Exit Sub
    If xn < -150 Then Exit Sub
    If z > Sheets("Sheet1").Range("A1").Value Then
    Else
        For i = 1 To xi
            MynCr i, xn - 1, x((i + 1) - 1, 1) & "+" & txt, x, z + x((i + 1) - 1, 1), v, 最大値, k
        Next
        If 最大値 < z Then
            最大値 = z
            v = Application.Transpose(Array(x(1, 1), x(2, 1), "結果"))
            w = Split(txt, "+")
            ReDim Preserve v(1 To 3, 1 To UBound(v, 2) + 1)
            v(1, UBound(v, 2)) = UBound(Filter(w, x(1, 1), True)) + 1
            v(2, UBound(v, 2)) = UBound(Filter(w, x(2, 1), True)) + 1
            v(3, UBound(v, 2)) = z
        Else
            If 最大値 = z Then
                w = Split(txt, "+")
                ReDim Preserve v(1 To 3, 1 To UBound(v, 2) + 1)
                v(1, UBound(v, 2)) = UBound(Filter(w, x(1, 1), True)) + 1
                v(2, UBound(v, 2)) = UBound(Filter(w, x(2, 1), True)) + 1
                v(3, UBound(v, 2)) = z
            End If
        End If
    End If
End Sub

 すみません。自分の研究用にそこそこ動く様に制限を付けました。
戻る時に最大値を更新していきます。
あくまでもそこそこです。。。(^^;
（SoulMan） 2021/04/21(水) 00:11

最大公約数から求めるという方法だと、今回のサンプルデータならいいですが、
例えば素数同士とかだと、最大公約数は1になるのでどうするのだろう。
どのようなコードでできたのか、興味があります。
提示してもらえませんかね。

とりあえず、自分なり考えてみました。

足す数値は２つだけなので、片方が決まれば、片方の個数は計算できます。
例えば、350が2個なら、280の個数は
(5000 - 350 * 2) \ 280 で計算できます。
個数が分かれば合計も計算できます。

あとは、ループで個数と合計を計算していって、それぞれ配列に格納していきます。
合計の配列からMax関数で最大値を取得を取得して、最大値に一致する配列の要素のインデックスから個数を取得すればいいでしょう。

 Sub main()
    Dim a1 As Long, a2 As Long, a3 As Long
    a1 = Range("A1").Value
    a2 = Range("A2").Value
    a3 = Range("A3").Value

    Dim aCnt() As Long, aSum() As Long
    ReDim aCnt(a1 \ a2) 'a3の個数の配列
    ReDim aSum(a1 \ a2) '合計の配列

    Dim i As Long, j As Long
    For i = 0 To a1 \ a2
        j = (a1 - a2 * i) \ a3
        s = a2 * i + a3 * j
        aCnt(i) = j
        aSum(i) = s
    Next

    Dim maxSum As Long
    maxSum = WorksheetFunction.Max(aSum) '最大合計値

    Dim r As Long
    r = 4
    For i = 0 To a1 \ a2
        If aSum(i) = maxSum Then
            Cells(r, 1).Value = i
            Cells(r + 1, 1).Value = aCnt(i)
            r = r + 2
        End If
    Next

 End Sub

（hatena） 2021/04/21(水) 18:15

 hatena さんのコードをお借りして
最初に最大公約数で目標値を決めて一致したものだけを取り出してみました。

 Option Explicit
Sub てすと()
Dim MyA As Variant
Dim MyAry As Variant
Dim MyMin As Double
Dim MyT As Double
Dim x As Double
Dim y As Double
Dim z As Double
Dim S As Double
Dim i As Long
Dim j As Long
Dim k As Long
With Sheets("Sheet1")
    MyT = .Range(" A1").Value
    MyA = .Range("A2:A3").Value
    MyMin = MyT \ Application.Min(MyA(1, 1), MyA(2, 1))
    x = Application.Gcd(MyA(1, 1), MyA(2, 1))
    y = MyT \ x
    z = x * y
End With
MyAry = Application.Transpose(Array(MyA(1, 1), MyA(2, 1), "結果"))
k = 1
For i = 0 To MyT \ MyA(1, 1)
    j = (MyT - MyA(1, 1) * i) \ MyA(2, 1)
    S = MyA(1, 1) * i + MyA(2, 1) * j
    If S = z Then
        k = k + 1
        ReDim Preserve MyAry(1 To 3, 1 To k)
        MyAry(1, k) = (z - (MyA(2, 1) * j)) \ MyA(1, 1)
        MyAry(2, k) = j
        MyAry(3, k) = S
    End If
Next
With Sheets("Sheet2")
    .Cells.Clear
    .Range("A1").Resize(UBound(MyAry, 2), UBound(MyAry, 1)).Value = Application.Transpose(MyAry)
End With
Erase MyA, MyAry
End Sub
すみません。A列とB列が反対でしたm(__)m
（SoulMan） 2021/04/21(水) 22:37

SoulManさん
それだと例えば、
A1 5000
A2 351
A3 280
だと結果がでないです。

351 と 280 の最大公約数は1になるので、目標値は5000になりますが、351と280の組み合わせでは5000にはなりませんので。

351*13+140*3=4983 が最大値になります。

（hatena） 2021/04/21(水) 23:47

ベズー等式というやつみたいだけどよくわからん
（めざめるパワー） 2021/04/22(木) 01:26

 おはようございます
あっ、そうなんですね
すみません
ありがとうございます😊
大変失礼いたしました　お許しください
奥が深いですね
そのバズー等式を見てみたいですね
では、では、
（SoulMan） 2021/04/22(木) 05:32

 ちょっと難しく考え過ぎていたかもです。
nCr関数を使いたかっただけかも^^;

 Option Explicit
Sub てすと()
Dim x As Variant
Dim v As Variant
Dim 最大値 As Double
Dim Temp最大値 As Double
Dim Num1 As Double
Dim Num2 As Double
Dim Num3 As Double
Dim i As Long
x = Sheets("Sheet1").Range("A1:A3").Value
For i = 0 To x(1, 1) \ x(2, 1)
    Num1 = x(2, 1) * i
    Num2 = x(1, 1) - Num1
    Num3 = (Num2 \ x(3, 1)) * x(3, 1)
    最大値 = Num1 + Num3
    If Temp最大値 < 最大値 Then
        Temp最大値 = 最大値
        v = Application.Transpose(Array(x(2, 1), x(3, 1), "結果"))
        ReDim Preserve v(LBound(v, 1) To UBound(v, 1), LBound(v, 2) To UBound(v, 2) + 1)
        v(1, UBound(v, 2)) = i
        v(2, UBound(v, 2)) = Num2 \ x(3, 1)
        v(3, UBound(v, 2)) = 最大値
    Else
        If Temp最大値 = 最大値 Then
            ReDim Preserve v(LBound(v, 1) To UBound(v, 1), LBound(v, 2) To UBound(v, 2) + 1)
            v(1, UBound(v, 2)) = i
            v(2, UBound(v, 2)) = Num2 \ x(3, 1)
            v(3, UBound(v, 2)) = 最大値
        End If
    End If
Next
With Sheets("Sheet2")
    .Cells.Clear
    .Range("A1").Resize(UBound(v, 2), UBound(v, 1)).Value = Application.Transpose(v)
End With
Erase x, v
End Sub
（SoulMan） 2021/04/22(木) 09:39

ベズー等式、初耳でしたので、調べてみました。

ベズーの等式 - Wikipedia
https://ja.wikipedia.org/wiki/%E3%83%99%E3%82%BA%E3%83%BC%E3%81%AE%E7%AD%89%E5%BC%8F

一次不定方程式ax+by=cの整数解 | 高校数学の美しい物語
https://manabitimes.jp/math/674

とかいろいろ出てきます。
難解なので完全に理解できてませんが、今回の質問の命題とは異なるものだと思います。
ax+by=c のcが定数の場合の話であって、今回は c は定数ではなく指定値以下でなるべく近いものという命題ですので。

ですので、そんなんに難しい話ではないかと。
具体的には前回の回答で計算法を説明してます。

ちなみに前回の私の回答のコードですが、変数宣言を一つ忘れてました。

 Dim s As Long

上記のコードを追加してください。
（hatena） 2021/04/22(木) 09:57

ありがとうございます。

5,000以内で
350と280の組合せでの最大となる
4,970が導き出され、

しかも、その4,970の中で
4+11=15
9+7=16
14+3=17
組み合わせの中でも最大値も導きだされるので
希望していた通りの事が出来ました。

ありがとうございます。
（お願いします） 2021/04/22(木) 17:47

コメント返信：

[ 一覧(最新更新順) ]

[[20210420122941]] 『最大公約数 組合せの自動計算』（お願いします） ページの最後に飛ぶ

[[20210420122941]]　『最大公約数　組合せの自動計算』（お願いします）　ページの最後に飛ぶ