|
![](https://clubstatic.excelhome.net/image/common/ico_lz.png)
楼主 |
发表于 2014-3-4 16:26
|
显示全部楼层
本帖最后由 香川群子 于 2014-3-8 21:01 编辑
写了个递归计算按系数拆分整数求全部组合解的代码。
可以用来处理解多元一次方程组全部组合解:- Dim sj, jg(), h&, h2&, k&, l&, m&, n&, n2&, r1&, cnt&
- Sub kagawa_11() '整数拆分
- tms = Timer
- m = [a1].End(4).Row: [a1].Resize(m).Sort [a1], 1, , , 2: sj = [a1].Resize(m)
- h = [b1]: h2 = [b2]: If h2 >= h Then h2 = h2 - h
- n = [b4]: n2 = [b5]: If n2 = 0 Then If n = 0 Then n2 = m Else n2 = n
- r1 = [b3]: l = [b6]: If l = 0 Then l = 65536
- ReDim jg(l, 3): jg(0, 0) = "h": jg(0, 1) = "f": jg(0, 2) = "n": jg(0, 3) = "f1"
- k = 0: cnt = 0: Call dgH11(h, "", "", m, 0): [b7] = k: [b8] = cnt
- MsgBox Format(Timer - tms, "0.000s ") & k & "/" & cnt
- If k Then [f1].CurrentRegion = "": [f1].Resize(k + 1, 4) = jg: [f1].CurrentRegion.AutoFilter Field:=1
- End Sub
- Sub dgH11(r&, s1$, s2$, i&, t&)
- Dim j&, h1&, rs$, t1&, t2&
- cnt = cnt + 1
-
- t1 = sj(i, 1)
- If i = 1 Then
- For j = IIf(r < t1, 0, r \ t1) To (r + h2 - 1) \ t1 + 1
- If j Then rs = "+" & t1 & "*" & j & s1 Else rs = s1
- If j = 0 Or (j And j > r1) Then
- h1 = Application.Evaluate(rs)
- If h <= h1 And h1 <= h + h2 Then
- t2 = IIf(j, t + 1, t)
- If n <= t2 And t2 <= n2 Then
- k = k + 1
- jg(k, 0) = h1
- jg(k, 1) = "+" & t1 & "*" & j & s2
- jg(k, 2) = t2
- jg(k, 3) = rs
- End If
- End If
- End If
- Next
- Exit Sub
- End If
-
- Call dgH11(r, s1, "+" & t1 & "*0" & s2, i - 1, t)
- For j = r1 + 1 To (r + h2 - 1) \ t1 + 1
- Call dgH11(r - t1 * j, IIf(j, "+" & t1 & "*" & j & s1, s1), "+" & t1 & "*" & j & s2, i - 1, IIf(j, t + 1, t))
- Next
- End Sub
复制代码 |
|