|
- Dim sj, sj1(), jg(), dic, h1&, h2&, k&, l&, m&, n1&, n2&, cnt&
- Sub MultiCombinH()
- ' Dim sj0, d&, i&, tms#
- tms = Timer
-
- ' [c1:c15] = "": [c1] = "目标和h": [c2] = "和上限h2": [c3] = "小数位d": [c4] = "个数n1": [c5] = "个数n2←"
- ' [c6] = "求解数l": [c7] = "结果k": [c8] = "计算cnt": [c9] = "计算时": [c10] = "总耗时"
- ' [e1] = "z": [f1] = "Type": [g1] = "Description"
-
- l = IIf([b6] = 0, 65530, [b6]): ReDim jg(l, 2)
- d = [b3]: h1 = [b1] * 10 ^ d: h2 = [b2]: If h2 Then h2 = h1 - h2 * 10 ^ d
-
- m = [a1].End(4).Row: ReDim sj1(m, 2)
- n1 = [b4]: n2 = [b5]: If n2 = 0 Then If n1 = 0 Then n2 = m Else n2 = n1
- sj0 = [a1].Resize(m): [a1].Resize(m).Sort [a1], 1, , , , , , 2
- sj = [a1].Resize(m): [a1].Resize(m) = sj0
- For i = 1 To m
- sj1(i, 0) = sj(i, 1) * 10 ^ d: sj1(i, 1) = m
- Next
- sj1(1, 2) = 1
-
- Set dic = CreateObject("Scripting.Dictionary")
- k = 0: cnt = 0: Call dgZH5(h1, "", "", 0, 1, 1, 1)
-
- [b7] = k: [b8] = cnt: [b9] = Format(Timer - tms, "0.000s"): [b10] = ""
- If k Then [e1].CurrentRegion.Offset(1) = "": [e2].Resize(k, 3) = jg: [e1].CurrentRegion.AutoFilter Field:=1: [b10] = Format(Timer - tms, "0.000s")
- MsgBox Format(Timer - tms, "0.000s ") & k & "/" & cnt
- End Sub
- Sub dgZH5(r&, s$, sz$, i&, z&, n&, nn&)
- Dim j&, j2&, r2&, s2$, t&, trr
- If k = l Then Exit Sub
- cnt = cnt + 1
-
- For j = i + 1 To m
- t = sj1(j, 0)
- If sj1(j, 1) > z Then
- r2 = r - sj1(j, 0)
- If nn = m Then
- s2 = Replace(Mid(s, 2), "|+", "|") & "+" & sj(j, 1) & "=" & h1 - r2
- ' s2 = Replace(Mid(s & "+" & sj1(j, 1), 2), "|+", "|")
- If h2 <= r2 And r2 <= 0 Then
- jg(k, 0) = z
- s2 = RecSort(Split(s2 & "|", "|"))
- s2 = Left(s2, Len(s2) - 1)
- Else
- jg(k, 0) = z - 1
- s2 = RecSort(Split(s2, "|"))
- End If
- If Not dic.Exists(s2) Then
- dic(s2) = ""
- jg(k, 1) = Mid(sz, 2) & "," & n & " ↑"
- jg(k, 2) = s2 & IIf(r2 > 0, "<" & h1, IIf(r2 < h2, ">" & h1 - h2, "<OK>"))
- k = k + 1
- End If
- Else
- sj1(j, 1) = z
- If n < n1 Then
- Call dgZH5(r2, s & "+" & sj(j, 1), sz, j, z, n + 1, nn + 1)
- Else
- If h2 <= r2 And r2 <= 0 Then
- t = sj1(z, 2): sj1(z + 1, 2) = t + 1
- Call dgZH5(h1, s & "+" & sj(j, 1) & "=" & h1 - r2 & "|", sz & "," & n, t, z + 1, 1, nn + 1)
- Else
- If n1 = 0 Then
- Call dgZH5(r2, s & "+" & sj(j, 1), sz, j, z, n + 1, nn + 1)
- Else
- If n < n2 Then If r2 > 0 Then Call dgZH5(r2, s & "+" & sj(j, 1), sz, j, z, n + 1, nn + 1)
- End If
- End If
- End If
- sj1(j, 1) = m
- End If
- Else
- If j = m Then
- r2 = 0: s2 = "": t = 0
- For j2 = 1 To m
- If sj1(j2, 1) >= z Then
- r2 = r2 + sj1(j2, 0)
- s2 = s2 & "+" & sj(j2, 1)
- t = t + 1
- End If
- Next
- If nn - n + t = m Then
- ' s2 = Replace(Left(Mid(s, 2), InStrRev(s, "|") - 1) & s2, "|+", "|") & "=" & r2
- s2 = Replace(Mid(Left(s, InStrRev(s, "|")) & s2 & "=" & r2, 2), "|+", "|")
- If h1 <= r2 And r2 <= h1 - h2 Then
- jg(k, 0) = z
- s2 = RecSort(Split(s2 & "|", "|"))
- s2 = Left(s2, Len(s2) - 1)
- Else
- jg(k, 0) = z - 1
- s2 = RecSort(Split(s2, "|"))
- End If
- If Not dic.Exists(s2) Then
- dic(s2) = ""
- jg(k, 1) = Mid(sz, 2) & "," & t
- jg(k, 2) = s2 & IIf(r2 < h1, "<" & h1, IIf(r2 > h1 - h2, ">" & h1 - h2, "<OK>"))
- k = k + 1
- End If
- End If
- End If
- End If
- Next
- End Sub
- Function RecSort(arr)
- Dim i&, j&, k&, l&, n&, s, t&, u&
- l = LBound(arr): n = l: u = UBound(arr)
- ReDim trr(l To u)
-
- For i = l To u - 1
- t = Val(arr(i))
- For j = l To n
- If Val(trr(j)) > t Then
- For k = n To j + 1 Step -1
- trr(k) = trr(k - 1)
- Next
- trr(k) = arr(i)
- Exit For
- End If
- Next
- If j > n Then trr(j - 1) = arr(i)
- n = n + 1
- Next
- trr(u) = arr(u)
- RecSort = Join(trr, "|")
- End Function
复制代码 |
评分
-
查看全部评分
|