寻找数学函数以找到最大可能的总和

Question

我有一组 4 位数字，我必须从中找出最大可能的和，最多包含 5 个项目，不超过 24,000，但不低于 21,000。尽管这听起来微不足道，而且我手工完成没有任何问题（集合不是很多），但我无法将其转移到电子表格中。

@编辑前任。数据集{4785,4890,5030,5790,6020,3230,4500,5000,4550,2300,5400,5350.....}

Answer 1

如果你按降序排列数据并计算部分和，那么递归算法很快就找到了解决方案（当然，如果存在的话）

Option Explicit     

Dim valRes() As Boolean
Dim indRng() As Long
Dim rngSum() As Currency
Dim ttlSum() As Currency
Dim lowA As Long, upA As Long

Rem The function returns an array of boolean values, 
Rem in which True marks the line numbers in the rngSumIsh range,
Rem from which the total can be collected with an acceptable error of no more than delta,
Rem or completely False - "No result"
Function findSet2(total As Double, rngSumIsh As Variant, Optional delta) As Variant
Dim restSum As Currency
Dim i As Long
Dim firstEl As Long, lastEl As Long
    If IsMissing(delta) Then  delta = 0
    If Not IsArray(rngSumIsh) Then
        findSet2 = False
        Exit Function
    End If
    If delta < 0 Then
        findSet2 = False
        Exit Function
    End If
    Call createWorkArrays(rngSumIsh)
    restSum = total
    findSet2 = valRes
    If restSum - delta < ttlSum(upA) Then Exit Function
    If restSum - delta > ttlSum(lowA) Then
        For i = lowA To upA
            valRes(i, 1) = True
        Next i
        findSet2 = valRes
        Exit Function
    End If

    Call getNextElem(lowA - 1, restSum, delta, firstEl, lastEl)
    If firstEl <= lastEl Then ' There is a suitable element
        For i = firstEl To lastEl
            If Abs(restSum - rngSum(indRng(i))) <= delta Then
                valRes(indRng(i), 1) = True
                Exit For
            ElseIf isfindSet2(i, restSum - rngSum(indRng(i)), delta) Then
                valRes(indRng(i), 1) = True
                Exit For
            End If
        Next i
    End If
    findSet2 = valRes
End Function

Function isfindSet2(curIndex As Long, restSum As Currency, delta As Currency) As Boolean
Dim i As Long, firstEl As Long, lastEl As Long
    isfindSet2 = False
    Call getNextElem(curIndex, restSum, delta, firstEl, lastEl)
    If firstEl <= lastEl Then
        For i = firstEl To lastEl
            If Abs(restSum - rngSum(indRng(i))) <= delta Then
                valRes(indRng(i), 1) = True
                isfindSet2 = True
                Exit For
            ElseIf isfindSet2(i, restSum - rngSum(indRng(i)), delta) Then
                valRes(indRng(i), 1) = True
                isfindSet2 = True
                Exit For
            End If
        Next i
    End If
End Function

Sub createWorkArrays(arrSum As Variant)
Dim i As Long, j As Long
Dim tmpVal As Long
    lowA = LBound(arrSum)
    upA = UBound(arrSum)
    ReDim rngSum(lowA To upA)
    ReDim valRes(lowA To upA, 1 To 1)
    ReDim indRng(lowA To upA)
    ReDim ttlSum(lowA To upA)
    For i = lowA To upA
        rngSum(i) = arrSum(i, 1)
        indRng(i) = i
        valRes(i, 1) = False
    Next i
Rem Let's "sort" the rngSum array (actually sort the array of its indices)
    For i = lowA To upA - 1
        For j = i + 1 To upA
            If rngSum(indRng(i)) < rngSum(indRng(j)) Then
                tmpVal = indRng(i)
                indRng(i) = indRng(j)
                indRng(j) = tmpVal
            End If
        Next j
    Next i
    ttlSum(upA) = rngSum(indRng(upA))
    For i = upA - 1 To lowA Step -1
        ttlSum(i) = ttlSum(i + 1) + rngSum(indRng(i))
    Next i
End Sub

Rem The procedure tries to find the next matching element in the rngSum array - firstEl starting from the next one after curIndex.
Rem A qualifying element is one whose sum adjusted for delta does not exceed the remainder.
Rem The last matching element in the ttlSum array is also searched for - lastEl
Rem (the amount of the remaining items is not less than the remainder)
Rem Returns the indices of found elements
Sub getNextElem(curIndex As Long, restSum As Currency, delta As Currency, ByRef firstEl As Long, ByRef lastEl As Long)
Dim i As Long 
    firstEl = upA + 1
    lastEl = lowA - 1
    If curIndex < upA Then
        For i = curIndex + 1 To upA
            If restSum + delta >= rngSum(indRng(i)) Then
                firstEl = i
                Exit For
            End If
        Next i
        For i = firstEl To upA
            If restSum - delta <= ttlSum(i) Then
                lastEl = i
            Else
                Exit For
            End If
        Next i
    End If
End Sub

如果您需要更多注释来理解代码，请参阅此 file

中的完整代码版本

Answer 2

Tools -> Solver 适用于您示例中的值。这是我使用的电子表格，单元格 A2 到 A13 中有数据。

   Data    Chosen Rows Chosen Values   Calculation
   4785    5           5790            24000
   4890    7           3230
   5030    4           5030
   5790    12          5400
   6020    10          4550
   3230                                      
   4500                                      
   5000                                      
   4550                                      
   2300                                      
   5400                                      
   5350

C2的公式为=INDIRECT("A"&B2)，向下填充至C6。那么 D2 就是 =SUM(C2:C6).

这里是规划求解设置。

同样在选项下，使用非线性求解器。指定变量是整数（这是必需的，即使我添加了整数作为限制条件）和非负数。

编辑:

every value can be used only once

在这种情况下，在单元格 B8 中输入以下数组公式，在中进行了解释。

=SUM(1/COUNTIF(B2:B6;B2:B6))

然后给求解器添加另一个限制条件：$B => 5.

寻找数学函数以找到最大可能的总和

Looking for math function for finding highest possibile sum

libreoffice-calc