加减组合算法

Question

数据源
a1= 1
a2= 2
a3= 3
要求数据源数据经过加或减组合写出下式结果
-6 → -A1-A2-A3
-5 → -A2-A3
-3 → -A3

Answer 1

你这个不是组合，只是从前向后一个个递减吧：
'写个函数：
sub tt(paramarray pam())    
    dim i as long,j as long
    dim sum as double
    for i=0 to ubound(pam)
        sum=0
        for j=i to ubound(pam)
            sum=sum+pam(j)
        next j
        debug.? -sum
    next
end sub'调用    
dim a1 as long,a2 as long,a3 as long
a1=1
a2=2
a3=3
tt a1,a2,a3
    

Answer 2

a1= 1 
a2= 2 
a3= 3 
1,2,3加减组合结果如下4 → A1+A3
0 → A1 + A2 - A3
6 → A1+ a2 + A3
5 → A2+A3
-4 → -A1-A3
-6 → -A1-A2-A3
-5 → -A2-A3
-1 → -A1
-2 → -A2
-3 → -A3
1 → A1
2 → A2
3 → A3目标需求
如输入一个数为-5 debug.print -A2-A3

Answer 3

Private Sub Form_Load()
Dim arr
Dim a1, a2, a3, i, j, t As Integer
a1 = 1
a2 = 2
a3 = 3
arr = Array(a1, a2, a3)
 For i = 0 To UBound(arr)
 For j = i To UBound(arr)
 t = t + arr(j)
 Next
 Debug.Print -t
 t = 0
 Next
End Sub

Answer 4

如输入一个数为-5 debug.print -A2-A3 
------------------------------------
如果输入一个-2，可能会有多个结果，比如是-a2 或者 a1-a3，是全部要，还是只要其一？

Answer 5

循环变量的各种组合，在这个循环中用加减号的各种排列去测试变量某一组合的计算结果，符合条件退出计算
组合和排列可以用递归，不过这儿用的是自己喜好的进位法
下面代码你测试下吧：
Option ExplicitPrivate Sub Command1_Click()    Dim a1 As Long, a2 As Long, a3 As Long
    a1 = 1
    a2 = 2
    a3 = 5
    Debug.Print GetResult(-5, a1, a2, a3)
    Debug.Print GetResult(5, a1, a2, a3)
    Debug.Print GetResult(-8, a1, a2, a3)
    Debug.Print GetResult(4, a1, a2, a3)
    
End Sub'变量下标的组合
Sub CarryCom(arr() As Long, M As Long, N As Long)
    
    Dim v As Long, i As Long
    v = M - N
    i = N
    Do
        arr(i) = arr(i) + 1
        If arr(i) > v + i Then
            arr(i) = 0
            i = i - 1
        Else
            Exit Do
        End If
    Loop
    Do While i < N
        i = i + 1
        arr(i) = arr(i - 1) + 1
    Loop
    
End Sub'加减符号的排列
Sub CarryPer(arr() As Long)
    
    Dim i As Long
    i = UBound(arr)
    Do
        arr(i) = arr(i) + 1
        If arr(i) <= 1 Then
            Exit Sub
        Else
            arr(i) = 0
            i = i - 1
        End If
    Loop
            
End Sub'主过程
Function GetResult(par As Long, ParamArray arr()) As String
    '参数par是你要的结果值，arr是你的变量值，不限个数
    Dim M As Long, N As Long
    Dim i As Long
    
    '将ParamArray中的变量赋值给一个数组(便于计算)
    N = UBound(arr)
    ReDim aTmp(N) As Long
    For i = 0 To N
        aTmp(i) = arr(i)
    Next
    '变量的总个数
    M = N + 1
    
    For N = 1 To M   '变量的M选N的组合
        '数组下标
        ReDim Index(N) As Long
        Index(0) = -1
        For i = 1 To N
            Index(i) = i
        Next
        
        Do
            '加减号
            ReDim Mark(N) As Long
            If Test(aTmp, Index, Mark, par, GetResult) Then
                Exit Function
            End If
            CarryCom Index, M, N
        Loop While Index(0) = -1
    Next
    
End Function'给每个变量的组合按各种排列测试结果
Function Test(pArr() As Long, pIndex() As Long, pMark() As Long, par As Long, res As String) As Boolean
    
    Dim i As Long
    Dim sum As Long
    Do
        res = vbNullString
        sum = 0
        For i = 1 To UBound(pIndex)
            If pMark(i) = 0 Then
                sum = sum + pArr(pIndex(i) - 1)
            Else
                sum = sum - pArr(pIndex(i) - 1)
            End If
            res = res & pMark(i) & "~" & "A" & pIndex(i) & ""
            If sum = par Then
                Test = True
                Exit Do
            End If
        Next
        CarryPer pMark
    Loop While pMark(0) = 0
　　 '处理输出结果
    res = Replace(res, "0~", "+")
    res = Replace(res, "1~", "-")
    If Left(res, 1) = "+" Then res = Mid(res, 2)
    
End Function

Answer 6

改下主过程，不然没有结果也会输出，这只是示例，代码有许多要优化，没时间弄：
'主过程
Function GetResult(par As Long, ParamArray arr()) As String
    
    Dim M As Long, N As Long
    Dim i As Long
    
    N = UBound(arr)
    ReDim aTmp(N) As Long
    For i = 0 To N
        aTmp(i) = arr(i)
    Next
    
    M = N + 1
    
    For N = 1 To M
        '数组下标
        ReDim Index(N) As Long
        Index(0) = -1
        For i = 1 To N
            Index(i) = i
        Next
        
        Do
            '加减号
            ReDim Mark(N) As Long
            If Test(aTmp, Index, Mark, par, GetResult) Then
                Exit Function
            Else
                GetResult = vbNullString
            End If
            CarryCom Index, M, N
        Loop While Index(0) = -1
    Next
    
End Function

Answer 7

感谢vbman2003高手参与,合计加115分.程序太难,还需仔细消化.