如何让Excel选取几个数字来求和？

Question

我不确定如何更好地表达这个问题，但请参阅下面所附的图片。基本上，在这个例子中，我有一个数字作为目标，10（在左边）。然后，我在右侧有一个号码列表，其中有一堆号码可供我选择。我正在寻找一种方法，从号码列表中选择一定数量的号码，使这些号码的总和等于目标号码。在下面的示例中，正确答案是选择“5”、“3”和“2”。

欢迎任何 Excel 函数、菜单栏中的工具或 VBA 代码。

Answer 1

我已经设法为此制定了一个 VBA 解决方案。我已经用多个不同的目标和不同的数字范围进行了测试，每次都进行总结和工作。但不能保证不存在无法解决的问题。

这是：

注意 - 您现在应该能够拥有多个相同的数字。这只会返回它找到的第一个解决方案。它没有找到所有解决方案。

Sub SumSolver()

Dim rng, Goal As Double, ws As Worksheet, i As Long, j As Long, Answer As Double, k As Long
Dim lRow As Long, Answerlist As String, LastAdded As Long, AnswerListPos As String
Dim c As Range, RngToSplit As String, AnswerArray, AnswerItem

Set ws = Sheets("Sheet1") 'Change Sheet1 to your sheet name
lRow = ws.Range("B" & ws.Rows.Count).End(xlUp).Row 'Change to needed column
ws.Range("C2:C" & lRow).ClearContents 'Clear output range if needed

For Each c In ws.Range("B2:B" & lRow) 'This loop populates the list range into a string
    If c.Value <> "" Or Not IsNumeric(c.Value) Then 'Checking for empty or non-numeric values
        If RngToSplit = "" Then
            RngToSplit = c.Value
        Else
            RngToSplit = RngToSplit & "," & c.Value
        End If
    End If
Next
rng = Split(RngToSplit, ",") 'Split the new list string into an array

If Not IsNumeric(ws.Range("A2").Value) Then 'Checks target value is actually a number
    MsgBox "The target value is not a valid number. Please correct this before trying again.", vbExclamation, "Sum Solver"
    Exit Sub
Else
    Goal = ws.Range("A2").Value 'Value of the goal/target
End If

For i = 0 To UBound(rng) ' 0 = start of array, Ubound = End of array
    If rng(i) = Goal Then
        ws.Range("C2") = rng(i)
        Answerlist = rng(i)
        GoTo SubExit
    ElseIf rng(i) < Goal Then
        Answer = rng(i)
        Answerlist = rng(i)
        AnswerListPos = i
        For j = i + 1 To UBound(rng)
            If Answer + rng(j) = Goal Then
                Answerlist = Answerlist & "," & rng(j)
                AnswerListPos = AnswerListPos & "," & j
                GoTo SubExit
            ElseIf Answer + rng(j) < Goal Then
                Answer = Answer + rng(j)
                LastAdded = j
                If Answerlist = "" Then
                    Answerlist = rng(j)
                    AnswerListPos = j
                Else
                    Answerlist = Answerlist & "," & rng(j)
                    AnswerListPos = AnswerListPos & "," & j
                End If
            End If
            If j = UBound(rng) Then
                If LastAdded = UBound(rng) Then
                    Answerlist = Left(Answerlist, InStrRev(Answerlist, ",") - 1)
                    AnswerListPos = Left(AnswerListPos, InStrRev(AnswerListPos, ",") - 1)
                    Answer = Answer - rng(j)
                    LastAdded = Val(Mid(AnswerListPos, InStrRev(AnswerListPos, ",") + 1))
                End If
                If LastAdded > 0 Then Answer = Answer - rng(LastAdded)
                If InStr(Answerlist, ",") = 0 Then Exit For
                j = Val(Mid(AnswerListPos, InStrRev(AnswerListPos, ",") + 1))
                Answerlist = Left(Answerlist, InStrRev(Answerlist, ",") - 1)
                AnswerListPos = Left(AnswerListPos, InStrRev(AnswerListPos, ",") - 1)
            End If
        Next j
    End If
    Answerlist = ""
Next i

SubExit:

If Answerlist <> "" Then
    i = 2
    AnswerArray = Split(Answerlist, ",") 'Split the result into an array
    For Each AnswerItem In AnswerArray
        ws.Range("C" & i) = AnswerItem 'Output the results into the sheet
        i = i + 1
    Next
Else
    MsgBox "No possible combination found for a target value of " & Goal & ".", vbExclamation, "Sum Solver"
End If

End Sub

编辑：刚刚更新以考虑列表范围中是否有任何空白行以及处理值是否为非数字。实际上，对于 12 项 1000 次迭代的列表，速度快了半秒（13 秒）。

您将看到我发表评论的行是您需要更改的行。几乎就是它正在处理的列和起始单元格它可以查看最后一行，但如果您不需要它，那么只需将例如

"B2:B" & lRow

替换为

B2:B5

等。

我也将它合并到一个函数中。用作：

=SumSolver(Target value, Range of sum values)

它返回同一单元格中的结果，并用逗号分隔。如果需要，可以轻松更改为另一种方法。

Function SumSolver(Goal As Double, ListRange As Range)

Dim i As Long, j As Long, Answer As Double, k As Long, rng As Variant
Dim Answerlist As String, LastAdded As Long, AnswerListPos As String

rng = Application.Transpose(ListRange)

For i = 1 To UBound(rng)
    If rng(i) = Goal Then
        Answerlist = rng(i)
        GoTo SubExit
    ElseIf rng(i) < Goal Then
        Answer = rng(i)
        Answerlist = rng(i)
        AnswerListPos = i
        For j = i + 1 To UBound(rng)
            If Answer + rng(j) = Goal Then
                Answerlist = Answerlist & "," & rng(j)
                AnswerListPos = AnswerListPos & "," & j
                GoTo SubExit
            ElseIf Answer + rng(j) < Goal Then
                Answer = Answer + rng(j)
                LastAdded = j
                If Answerlist = "" Then
                    Answerlist = rng(j)
                    AnswerListPos = j
                Else
                    Answerlist = Answerlist & "," & rng(j)
                    AnswerListPos = AnswerListPos & "," & j
                End If
            End If
            If j = UBound(rng) Then
                If LastAdded = UBound(rng) Then
                    Answerlist = Left(Answerlist, InStrRev(Answerlist, ",") - 1)
                    AnswerListPos = Left(AnswerListPos, InStrRev(AnswerListPos, ",") - 1)
                    Answer = Answer - rng(j)
                    LastAdded = Val(Mid(AnswerListPos, InStrRev(AnswerListPos, ",") + 1))
                End If
                If LastAdded > 0 Then Answer = Answer - rng(LastAdded)
                If InStr(Answerlist, ",") = 0 Then Exit For
                j = Val(Mid(AnswerListPos, InStrRev(AnswerListPos, ",") + 1))
                Answerlist = Left(Answerlist, InStrRev(Answerlist, ",") - 1)
                AnswerListPos = Left(AnswerListPos, InStrRev(AnswerListPos, ",") - 1)
            End If
        Next j
    End If
    Answerlist = ""
Next i

SubExit:

If Answerlist <> "" Then
    SumSolver = Answerlist
Else
    SumSolver = "N/A"
End If

End Function

示例：

我决定更新我的速度测试。这次将更新后的代码与原始代码进行比较，并惊讶地发现了差异。我运行了 1000 次迭代，但求解器无法找到组合。我是在屏幕更新打开的情况下完成的。对于 8 个列表，最多有 255 个组合；对于 12 个列表，最多有 4095 个组合（每添加一个项目，就会加倍）。对于 12 个列表，需要进行 4,095,000 次计算。更新后的代码平均用时 13.6 秒。显然这是在我的机器上，它会产生与你的不同的结果（但比率应该仍然大致相同）。

Answer 2

所以，就像这样：

=sumproduct(C5:C10,D5:D10)

是单元格 B8 中的公式，也是求解器中的目标。

这两个约束控制模型，请检查选项以确保未选择“忽略整数”。

使用二进制，因为这是选定或未选定的情况。

我在约束中使用了等于，但在某些情况下您可能需要使用<= or >=，因为可能没有精确的解决方案。

求解器还处理相同的多个值，但与其他答案不同，因为有多个解决方案，所以选择的解决方案是随机的：

Answer 3

我为此开发了一个谷歌表格插件（抱歉，不适用于Excel），并且大多数时候它可以处理数千个数字。

目前是免费的（一旦获得更多功能，将来可能会成为一次性付费的付费附加组件）。

如果您有兴趣，请查看https://workspace.google.com/marketplace/app/add_up_to/1020284067440