Excel精英培训网

 找回密码
 注册
数据透视表40+个常用小技巧,让你一次学会!
楼主: 雄鹰2013

[已解决]如何实现几个数相加等于一个固定的值

[复制链接]
 楼主| 发表于 2014-7-5 11:10 | 显示全部楼层
香川群子 发表于 2014-7-4 17:04
嗯,这是我几年前的作品……已不能代表我的最新研究成果……。

能上传最新成果吗
excel精英培训的微信平台,每天都会发送excel学习教程和资料。扫一扫明天就可以收到新教程
回复

使用道具 举报

 楼主| 发表于 2014-7-5 11:11 | 显示全部楼层
回复

使用道具 举报

发表于 2014-7-5 23:55 | 显示全部楼层
6+7+9+53+62=137|+11+21+105=137|+12+18+34+73=137|+25+31+81=137|+50+71=121<137
6+7+9+53+62=137|+11+21+105=137|+25+31+81=137|+12+18+34+73=137|+50+71=121<137
6+7+9+53+62=137|+12+18+34+73=137|+11+21+105=137|+25+31+81=137|+50+71=121<137
6+7+9+53+62=137|+12+18+34+73=137|+25+31+81=137|+11+21+105=137|+50+71=121<137
6+7+9+53+62=137|+25+31+81=137|+11+21+105=137|+12+18+34+73=137|+50+71=121<137
6+7+9+53+62=137|+25+31+81=137|+12+18+34+73=137|+11+21+105=137|+50+71=121<137
回复

使用道具 举报

发表于 2014-7-6 12:35 | 显示全部楼层
6+7+53+71=137|11+21+105=137|12+18+34+73=137|25+31+81=137|50+62+9=121<137
6+7+53+71=137|11+21+105=137|12+18+34+73=137|25+50+62=137|31+81+9=121<137
7+9+50+71=137|11+21+105=137|12+18+34+73=137|25+31+81=137|53+62+6=121<137

专门写了个递归算法的程序。



递归分组凑数.rar

19.2 KB, 下载次数: 139

回复

使用道具 举报

发表于 2014-7-6 12:41 | 显示全部楼层
下面这个程序速度快,但不保证得到最优解。

快速装箱分组.rar

19.8 KB, 下载次数: 128

评分

参与人数 1学分 +1 收起 理由
upobeyond + 1 我和小伙伴都惊呆了

查看全部评分

回复

使用道具 举报

 楼主| 发表于 2014-7-7 13:15 | 显示全部楼层
谢谢香川老师
回复

使用道具 举报

发表于 2014-7-7 16:00 | 显示全部楼层
对计算结果进一步用字典对比排除重复。

1.列出组合结果中符合条件解的个数z
2.列出组合类型
3.列出组合表达式、末尾有最后一组的判断。

递归分组凑数.zip

31.47 KB, 下载次数: 159

评分

参与人数 1学分 +1 收起 理由
upobeyond + 1 神马都是浮云

查看全部评分

回复

使用道具 举报

发表于 2014-7-7 16:02 | 显示全部楼层

  1. Dim sj, sj1(), jg(), dic, h1&, h2&, k&, l&, m&, n1&, n2&, cnt&
  2. Sub MultiCombinH()
  3. '    Dim sj0, d&, i&, tms#
  4.     tms = Timer
  5.    
  6. '    [c1:c15] = "": [c1] = "目标和h": [c2] = "和上限h2": [c3] = "小数位d": [c4] = "个数n1": [c5] = "个数n2←"
  7. '    [c6] = "求解数l": [c7] = "结果k": [c8] = "计算cnt": [c9] = "计算时": [c10] = "总耗时"
  8. '    [e1] = "z": [f1] = "Type": [g1] = "Description"
  9.    
  10.     l = IIf([b6] = 0, 65530, [b6]): ReDim jg(l, 2)
  11.     d = [b3]: h1 = [b1] * 10 ^ d: h2 = [b2]: If h2 Then h2 = h1 - h2 * 10 ^ d
  12.    
  13.     m = [a1].End(4).Row: ReDim sj1(m, 2)
  14.     n1 = [b4]: n2 = [b5]: If n2 = 0 Then If n1 = 0 Then n2 = m Else n2 = n1
  15.     sj0 = [a1].Resize(m): [a1].Resize(m).Sort [a1], 1, , , , , , 2
  16.     sj = [a1].Resize(m): [a1].Resize(m) = sj0
  17.     For i = 1 To m
  18.         sj1(i, 0) = sj(i, 1) * 10 ^ d: sj1(i, 1) = m
  19.     Next
  20.     sj1(1, 2) = 1
  21.    
  22.     Set dic = CreateObject("Scripting.Dictionary")
  23.     k = 0: cnt = 0: Call dgZH5(h1, "", "", 0, 1, 1, 1)
  24.    
  25.     [b7] = k: [b8] = cnt: [b9] = Format(Timer - tms, "0.000s"): [b10] = ""
  26.     If k Then [e1].CurrentRegion.Offset(1) = "": [e2].Resize(k, 3) = jg: [e1].CurrentRegion.AutoFilter Field:=1: [b10] = Format(Timer - tms, "0.000s")
  27.     MsgBox Format(Timer - tms, "0.000s ") & k & "/" & cnt
  28. End Sub
  29. Sub dgZH5(r&, s$, sz$, i&, z&, n&, nn&)
  30.     Dim j&, j2&, r2&, s2$, t&, trr
  31.     If k = l Then Exit Sub
  32.     cnt = cnt + 1
  33.    
  34.     For j = i + 1 To m
  35.         t = sj1(j, 0)
  36.         If sj1(j, 1) > z Then
  37.             r2 = r - sj1(j, 0)
  38.             If nn = m Then
  39.                 s2 = Replace(Mid(s, 2), "|+", "|") & "+" & sj(j, 1) & "=" & h1 - r2
  40. '                s2 = Replace(Mid(s & "+" & sj1(j, 1), 2), "|+", "|")
  41.                 If h2 <= r2 And r2 <= 0 Then
  42.                     jg(k, 0) = z
  43.                     s2 = RecSort(Split(s2 & "|", "|"))
  44.                     s2 = Left(s2, Len(s2) - 1)
  45.                 Else
  46.                     jg(k, 0) = z - 1
  47.                     s2 = RecSort(Split(s2, "|"))
  48.                 End If
  49.                 If Not dic.Exists(s2) Then
  50.                     dic(s2) = ""
  51.                     jg(k, 1) = Mid(sz, 2) & "," & n & " ↑"
  52.                     jg(k, 2) = s2 & IIf(r2 > 0, "<" & h1, IIf(r2 < h2, ">" & h1 - h2, "<OK>"))
  53.                     k = k + 1
  54.                 End If
  55.             Else
  56.                 sj1(j, 1) = z
  57.                 If n < n1 Then
  58.                     Call dgZH5(r2, s & "+" & sj(j, 1), sz, j, z, n + 1, nn + 1)
  59.                 Else
  60.                     If h2 <= r2 And r2 <= 0 Then
  61.                         t = sj1(z, 2): sj1(z + 1, 2) = t + 1
  62.                         Call dgZH5(h1, s & "+" & sj(j, 1) & "=" & h1 - r2 & "|", sz & "," & n, t, z + 1, 1, nn + 1)
  63.                     Else
  64.                         If n1 = 0 Then
  65.                             Call dgZH5(r2, s & "+" & sj(j, 1), sz, j, z, n + 1, nn + 1)
  66.                         Else
  67.                             If n < n2 Then If r2 > 0 Then Call dgZH5(r2, s & "+" & sj(j, 1), sz, j, z, n + 1, nn + 1)
  68.                         End If
  69.                     End If
  70.                 End If
  71.                 sj1(j, 1) = m
  72.             End If
  73.         Else
  74.             If j = m Then
  75.                 r2 = 0: s2 = "": t = 0
  76.                 For j2 = 1 To m
  77.                     If sj1(j2, 1) >= z Then
  78.                         r2 = r2 + sj1(j2, 0)
  79.                         s2 = s2 & "+" & sj(j2, 1)
  80.                         t = t + 1
  81.                     End If
  82.                 Next
  83.                 If nn - n + t = m Then
  84. '                    s2 = Replace(Left(Mid(s, 2), InStrRev(s, "|") - 1) & s2, "|+", "|") & "=" & r2
  85.                     s2 = Replace(Mid(Left(s, InStrRev(s, "|")) & s2 & "=" & r2, 2), "|+", "|")
  86.                     If h1 <= r2 And r2 <= h1 - h2 Then
  87.                         jg(k, 0) = z
  88.                         s2 = RecSort(Split(s2 & "|", "|"))
  89.                         s2 = Left(s2, Len(s2) - 1)
  90.                     Else
  91.                         jg(k, 0) = z - 1
  92.                         s2 = RecSort(Split(s2, "|"))
  93.                     End If
  94.                     If Not dic.Exists(s2) Then
  95.                         dic(s2) = ""
  96.                         jg(k, 1) = Mid(sz, 2) & "," & t
  97.                         jg(k, 2) = s2 & IIf(r2 < h1, "<" & h1, IIf(r2 > h1 - h2, ">" & h1 - h2, "<OK>"))
  98.                         k = k + 1
  99.                     End If
  100.                 End If
  101.             End If
  102.         End If
  103.     Next
  104. End Sub
  105. Function RecSort(arr)
  106.     Dim i&, j&, k&, l&, n&, s, t&, u&
  107.     l = LBound(arr): n = l: u = UBound(arr)
  108.     ReDim trr(l To u)
  109.    
  110.     For i = l To u - 1
  111.         t = Val(arr(i))
  112.         For j = l To n
  113.             If Val(trr(j)) > t Then
  114.                 For k = n To j + 1 Step -1
  115.                     trr(k) = trr(k - 1)
  116.                 Next
  117.                 trr(k) = arr(i)
  118.                 Exit For
  119.             End If
  120.         Next
  121.         If j > n Then trr(j - 1) = arr(i)
  122.         n = n + 1
  123.     Next
  124.     trr(u) = arr(u)
  125.     RecSort = Join(trr, "|")
  126. End Function
复制代码

评分

参与人数 2 +6 收起 理由
jzkwf + 3 赞一个
zss7758258 + 3 太强悍了

查看全部评分

回复

使用道具 举报

发表于 2014-10-29 11:55 | 显示全部楼层
不服不行啊
回复

使用道具 举报

发表于 2015-5-23 10:58 | 显示全部楼层
雄鹰2013 发表于 2014-7-4 15:26
找到了,谢谢香川老师

非常感谢
回复

使用道具 举报

您需要登录后才可以回帖 登录 | 注册

本版积分规则

小黑屋|手机版|Archiver|Excel精英培训 ( 豫ICP备11015029号 )

GMT+8, 2024-3-29 02:26 , Processed in 0.864965 second(s), 18 queries , Gzip On, Yac On.

Powered by Discuz! X3.4

Copyright © 2001-2020, Tencent Cloud.

快速回复 返回顶部 返回列表