在VBA子集和算法(Subset sum algorithm in vba)

我试图写一个算法来解决一个子集和问题。

我相信我有这个算法的开始，但是我想写的东西，将开始与1套取决于数组的长度N套。理想情况下，最终会吐出第一个匹配的结果。

我认为，这可能是更好的方式，因为它遵循一个模式写的。

任何输入被理解。

谢谢！

安东尼奥

Function SubnetSum()

Dim num() As Variant
Dim goal As Double
Dim result As Double

Num() = array (1,2,3,4,5,6,7,8,9,10)

goal = 45

For i = LBound(num) To UBound(num)
    If num(i) = goal Then
        MsgBox num(i) & " " & goal & " 1 Set"
        Exit Function
    End If
Next

For i = LBound(num) To UBound(num)
    For j = i + 1 To UBound(num)
        If num(i) + num(j) = goal Then
            result = num(i) + num(j)
            MsgBox result & " " & goal & " 2 Sets"
            Exit Function
        End If
    Next
Next

For i = LBound(num) To UBound(num)
    For j = i + 1 To UBound(num)
        For k = j + 1 To UBound(num)
            If num(i) + num(j) + num(k) = goal Then
                result = num(i) + num(j) + num(k)
                MsgBox result & " " & goal & " 3 Sets"
                Exit Function
            End If
        Next
    Next
Next

For i = LBound(num) To UBound(num)
    For j = i + 1 To UBound(num)
        For k = j + 1 To UBound(num)
            For l = k + 1 To UBound(num)
                If num(i) + num(j) + num(k) + num(l) = goal Then
                    result = num(i) + num(j) + num(k) + num(l)
                    MsgBox result & " " & goal & " 4 Sets"
                    Exit Function
                End If
            Next
        Next
    Next
Next

For i = LBound(num) To UBound(num)
    For j = i + 1 To UBound(num)
        For k = j + 1 To UBound(num)
            For l = k + 1 To UBound(num)
                For m = l + 1 To UBound(num)
                    If num(i) + num(j) + num(k) + num(l) + num(m) = goal Then
                        result = num(i) + num(j) + num(k) + num(l) + num(m)
                        MsgBox result & " " & goal & " 5 Sets"
                        Exit Function
                    End If
                Next
            Next
        Next
    Next
Next

MsgBox "Nothing found"

End Function

编辑

对于文章@Enderland谢谢，我觉得这是很有趣，我很抱歉，因为这是我的这个网站上的第一篇文章。

我所试图做的是即我有9一个目标，使用数字组[1,2,3,4,5]，我想找到最优化的方式去5解决一个子集和问题使用阵列中的数字的组合。

可能的解决方案是[5]，[5,4]，[5,3,1]，[4,3,2]。不过，我想获得最优化的解决方案，它是[5]。

此外，如果我的目标是从[1,2,3,4,5]它将通过所有数字的阵列内的可能的另外的组合环和吐出最最优解，在这种情况下是[5获得14 ，4,3,2]。

我的代码做的是，它遍历数组数多达5个值，直到它获得最优化的解决方案。

我想要做的是写一个递归循环，使得它不硬编码到只有5可能的值。相反，我希望能够遍历号码基于所述阵列的大小为N的可能值的组合。

然而，我一个也想不出一个循环，将支持该功能。我敢肯定，它可能一点点的递归。

我想我的问题是...有没有办法来巩固我在上面为一个复杂的递归函数的代码？

谢谢！

我需要一个类似的递归函数。下面是代码。

*添加自己的错误处理

Public Function fSubSet(arr As Variant, goal As Double, Optional arrIndices As Variant) As Boolean

    Dim i As Integer
    Dim intSumSoFar As Integer

    i = 0
    If IsMissing(arrIndices) Then
        arrIndices = Array(0)
    End If
    For i = LBound(arrIndices) To UBound(arrIndices)
        intSumSoFar = intSumSoFar + arr(arrIndices(i))
    Next
     If intSumSoFar = goal Then
        For i = LBound(arrIndices) To UBound(arrIndices)
            Debug.Print arr(arrIndices(i))
        Next
        fSubSet = True
        Exit Function
    End If
    'now we increment one piece of the array starting from the last one
    i = UBound(arrIndices)
    Do While i > -1
        If arrIndices(i) + (UBound(arrIndices) - i) < UBound(arr) Then
            arrIndices(i) = arrIndices(i) + 1
            Exit Do
        End If
        i = i - 1
    Loop
    'if we are on the first index of the indices array and it is pushed as far as it can go then reset the array and add one to it if that doesn't make it too big
    If i = -1 And UBound(arrIndices) < UBound(arr) Then
        ReDim arrIndices(UBound(arrIndices) + 1)
        For i = 0 To UBound(arrIndices)
            arrIndices(i) = i
        Next
        'we need to end this monster
    ElseIf i = -1 And UBound(arrIndices) = UBound(arr) Then
        fSubSet = False
        Exit Function
    End If

    fSubSet = fSubSet(arr, goal, arrIndices)

End Function
Public Function fTestSubSet()
    Debug.Print fSubSet(Array(1, 2, 5, 6, 11, 10), 35)
End Function