Finding all possible combinations of numbers to reach a given sum

前端 未结 30 3040
一个人的身影
一个人的身影 2020-11-21 06:39

How would you go about testing all possible combinations of additions from a given set N of numbers so they add up to a given final number?

A brief exam

30条回答
  •  情深已故
    2020-11-21 06:56

    Excel VBA version below. I needed to implement this in VBA (not my preference, don't judge me!), and used the answers on this page for the approach. I'm uploading in case others also need a VBA version.

    Option Explicit
    
    Public Sub SumTarget()
        Dim numbers(0 To 6)  As Long
        Dim target As Long
    
        target = 15
        numbers(0) = 3: numbers(1) = 9: numbers(2) = 8: numbers(3) = 4: numbers(4) = 5
        numbers(5) = 7: numbers(6) = 10
    
        Call SumUpTarget(numbers, target)
    End Sub
    
    Public Sub SumUpTarget(numbers() As Long, target As Long)
        Dim part() As Long
        Call SumUpRecursive(numbers, target, part)
    End Sub
    
    Private Sub SumUpRecursive(numbers() As Long, target As Long, part() As Long)
    
        Dim s As Long, i As Long, j As Long, num As Long
        Dim remaining() As Long, partRec() As Long
        s = SumArray(part)
    
        If s = target Then Debug.Print "SUM ( " & ArrayToString(part) & " ) = " & target
        If s >= target Then Exit Sub
    
        If (Not Not numbers) <> 0 Then
            For i = 0 To UBound(numbers)
                Erase remaining()
                num = numbers(i)
                For j = i + 1 To UBound(numbers)
                    AddToArray remaining, numbers(j)
                Next j
                Erase partRec()
                CopyArray partRec, part
                AddToArray partRec, num
                SumUpRecursive remaining, target, partRec
            Next i
        End If
    
    End Sub
    
    Private Function ArrayToString(x() As Long) As String
        Dim n As Long, result As String
        result = "{" & x(n)
        For n = LBound(x) + 1 To UBound(x)
            result = result & "," & x(n)
        Next n
        result = result & "}"
        ArrayToString = result
    End Function
    
    Private Function SumArray(x() As Long) As Long
        Dim n As Long
        SumArray = 0
        If (Not Not x) <> 0 Then
            For n = LBound(x) To UBound(x)
                SumArray = SumArray + x(n)
            Next n
        End If
    End Function
    
    Private Sub AddToArray(arr() As Long, x As Long)
        If (Not Not arr) <> 0 Then
            ReDim Preserve arr(0 To UBound(arr) + 1)
        Else
            ReDim Preserve arr(0 To 0)
        End If
        arr(UBound(arr)) = x
    End Sub
    
    Private Sub CopyArray(destination() As Long, source() As Long)
        Dim n As Long
        If (Not Not source) <> 0 Then
            For n = 0 To UBound(source)
                    AddToArray destination, source(n)
            Next n
        End If
    End Sub
    

    Output (written to the Immediate window) should be:

    SUM ( {3,8,4} ) = 15
    SUM ( {3,5,7} ) = 15
    SUM ( {8,7} ) = 15
    SUM ( {5,10} ) = 15 
    

提交回复
热议问题