N个数加减乘除组合的递归代码

彭希仁

ublic arr1(1 To 65536, 1 To 1), z
Sub peng()
    Dim arr2(1 To 65536, 1 To 1)
    l = 2
    arr = Range("A1:A" & [A65536].End(xlUp).Row)
    xi arr, ",", UBound(arr)
    For i = 1 To z
        arr = Split(arr1(i, 1), ",")
        ren arr, 1, UBound(arr) - 1, ar
        For j = 1 To UBound(ar)
            zz = zz + 1
            arr2(zz, 1) = ar(j)
            If zz = 65536 Then
                Cells(1, l).Resize(zz, 1) = arr2
                zz = 0
                l = l + 1
            End If
        Next
    Next i
    Cells(1, l).Resize(zz, 1) = arr2    '得到所有数的组合
End Sub
Sub xi(arr, s, j)    'S代表位置
    If j = 0 Then
        z = z + 1
        arr1(z, 1) = s
        Exit Sub
    End If
    For i = 1 To UBound(arr)
        If Not s Like "*," & arr(i, 1) & ",*" Then     '得到所有数的组合
            xi arr, s & arr(i, 1) & ",", j - 1
        End If
    Next i
End Sub
Sub ren(arr, a, b, ar)
    ReDim ar(1 To 1)
    If a = b Then ar(1) = arr(a): Exit Sub
    y = 0
    For i = a To b - 1
        ren arr, a, i, ar1
        ren arr, i + 1, b, ar2
        ReDim Preserve ar(1 To y + UBound(ar1) * UBound(ar2) * 4)
        For ii = 1 To UBound(ar1)
            For jj = 1 To UBound(ar2)
                y = y + 1
                ar(y) = "(" & ar1(ii) & "*" & ar2(jj) & ")"
                y = y + 1
                ar(y) = "(" & ar1(ii) & "/" & ar2(jj) & ")"
                y = y + 1
                ar(y) = "(" & ar1(ii) & "+" & ar2(jj) & ")"
                y = y + 1
                ar(y) = "(" & ar1(ii) & "-" & ar2(jj) & ")"
            Next
        Next
    Next i
End Sub

cjh-01

虽然看不懂，但绝对值得收藏

香川群子

沙发没了。搬个凳子，好好学习！

qigengzier

前来虚心求知

d346836673

学习啦  ！