各位大神请帮忙修改一个excel的vba 程序被

不填海的精卫 2016-06-20 01:40:45

这个vba 是用来求元素不重复组合求和，打印了所有的组合方式，但是我的需求是，一个数已经使用了的话，就不参与下一次组合了,比如 1,2,3,4,5,6,7,8, 1,2,3使用了，下一次组合只用4,5,6,7,8,并且把最后无法参与组合的数，标记一下，或输出到一列里，，谢谢大家！！



Dim sj, jg(), m%, n%, k&, h1%, h2%, cnt&

'定义递归所需调用的公共变量：

'sj 为任意变量，用来获取原始数据到数组

'jg()为储存结果的数组，大小在主代码中重新Redim定义

'm为组合元素总数

'n为抽取元素个数参数，范围1-m之间时取定值个数，即程序仅仅计算返回指定元素个数的组合。

'   当n取值为空或输入n>m(如n=m+1)时则程序计算返回所有符合要求的组合而不论元素个数。

'k为结果序号，在代码运行过程中递增+1

'h1是总和目标下限、h2是总和目标上限，即目标和值范围=[h1,h2]，如果h1=h2时，当然就只取完全相等的值。

'cnt是所有递归计算次数。



Sub kagawa() '元素不重复组合求和 符合目标值范围[h1-h2] 的主过程代码

    tms = Timer

    m = [a1].End(4).Row - 1: sj0 = [a2].Resize(m): [a2].Resize(m).Sort [a2], 1, , , 2 '原始数据元素从小到大排序

    sj = [a2].Resize(m): [a2].Resize(m) = sj0 '排序后原始数据读入数组sj然后恢复工作表中原始数据状态

    h1 = [b2]: If [b3] = "" Then h2 = h1 Else h2 = [b3] '获取目标和值范围[h1-h2]

    If [b5] = "" Then n = m + 1 Else n = [b5] '组合元素个数指定,n为空时不指定个数给出所有解

    ReDim jg(65535, -1 To n) '定义结果数组大小 行数为Excel 2003最大行数 列数为指定元素个数

    k = 1: cnt = 0 'k和cnt参数归零

    MsgBox sj(5, 1)

    Call bcfhdg(0, "", 0, 0)  '调用递归计算过程

    MsgBox "Calc " & cnt - 1 & " ,Get " & k - 1 & " result." & vbCr & Format(Timer - tms, "0.000s")

    

    

    '以下为输出结果代码，解释从略

    jg(0, -1) = "个数": n = jg(0, 0): jg(0, 0) = "总和": For i = 1 To n: jg(0, i) = "n" & i: Next

    [e1].CurrentRegion.Clear: [b6] = k - 1: [b7] = cnt - 1

    If k > 1 Then [e1].Resize(k, n + 2) = jg: [e1].Resize(, n + 2).EntireColumn.AutoFit '

    

End Sub

Sub bcfhdg(r%, s$, i%, t%) '不重复组合求和的递归过程代码

'参数s是组合结果的文本格式、r是组合结果的和值、i是递归进程位置指针、t是组合抽取个数指针

    Dim j%

    cnt = cnt + 1 '递归计算次数递增+1

    

    p = Split(s, "+")

    For j = 1 To UBound(p)

        jg(0, j) = p(j) '当前递归结果分解存入状态栈，以便下一次递归是检查比对

    Next

    

    If r >= h1 And r <= h2 Then '如果本次递归组合结果的和值已经在总和目标范围内，则：

        If n > m Or t = n Then '如果参数n>m是则结果都要，或者n在1-m之间时必须t=n即抽取个数正好符合条件。

            If t > jg(0, 0) Then jg(0, 0) = t

            jg(k, -1) = t

            For j = 1 To UBound(p)

                jg(k, j) = p(j) '符合总和条件的本次递归结果写入结果数组。

            Next

            jg(k, 0) = "=" & Mid(s, 2) '第一列文本格式改写为=计算式，最后输出结果时直接得到计算式结果。

            k = k + 1 '结果序号递增+1

        End If

        'Exit Sub '退出以后的递归进程，加速计算过程。

        '注意：如果原始数据数值间隔小、目标和值的范围相对较大时，则这一句要注释掉，否则会漏掉一些正确的答案。

    End If

    If t = n Then Exit Sub 'n>m → go on 当n参数>m时应该继续，而n在1-m之间时因为t已经满足抽取个数则可退出递归进程。

    

    For j = i + 1 To m '递归遍历检查所有原始元素

        If r + sj(j, 1) > h2 Then Exit For '如果本次递归结果的和值已经大于总和目标范围上限，则可退出循环了。

        If CStr(sj(j, 1)) <> jg(0, t + 1) Then '检查本次递归进程中最新位置值，和前面上次递归状态栈比对，不重复才可继续

            If t < n - 1 Then jg(0, t + 2) = "" '递归最新状态栈位清空，否则会对下一次递归的比对造成错误干扰。

            Call bcfhdg(r + sj(j, 1), s & "+" & sj(j, 1), j, t + 1) '满足条件时，继续调用递归进行下一个组合位置的递归计算。

        End If

    Next j

End Sub