字典+递归进行凑数

liulang0808

昨天整理了相关字典的帖子http://club.excelhome.net/thread-1385473-1-1.html

今天处理了一个递归的问题，于是心血来潮，搞了这个字典+递归进行凑数，供大家参考

1. Public d
   
2. Public a
   
3. Public arr
   
4. Public m
   
5. Sub lqxs_zd()
   
6.     Application.ScreenUpdating = False
   
7.     ActiveSheet.UsedRange.Offset(0, 2).ClearContents
   
8.     Set d = CreateObject("scripting.dictionary")
   
9.     arr = [a1].CurrentRegion
   
10.     a = 3
    
11.     m = Application.InputBox("请输入数字：", "凑数", 10, , , , , 1)
    
12.     For j = 2 To UBound(arr)
    
13.         If arr(j, 1) < m Then
    
14.             d(j) = arr(j, 1)
    
15.             dg j
    
16.             If d.Count > 0 Then d.Remove j
    
17.         Else
    
18.             If arr(j, 1) = m Then
    
19.                 Cells(1, a) = arr(j, 1)
    
20.                 a = a + 1
    
21.             End If
    
22.         End If
    
23.         
    
24.     Next j
    
25.     Application.ScreenUpdating = True
    
26. End Sub
    
27. Sub dg(y)
    
28.     For j = y + 1 To UBound(arr)
    
29.         sm = WorksheetFunction.Sum(d.items)
    
30.         If sm + arr(j, 1) = m Then
    
31.             d(j) = arr(j, 1)
    
32.             Cells(1, a).Resize(d.Count) = WorksheetFunction.Transpose(d.items)
    
33.             a = a + 1
    
34.             d.Remove j
    
35.         Else
    
36.             If sm + arr(j, 1) < m Then
    
37.                 d(j) = arr(j, 1)
    
38.                 dg j
    
39.             End If
    
40.         End If
    
41.         If d.exists(j) Then d.Remove j
    
42.     Next j
    
43. End Sub

复制代码

aman1516

谢谢分享，学习学习！

香川群子

凑数用递归算法是正常的考虑，但是其中使用了字典，会大大降低计算速度。

如果可以，应尽量改用数组进行计算处理。

香川群子

按你的递归组合模板，不用字典，改用数组记录，重新写了代码，供楼主参考学习。

1. Dim a(), b(), h&, m&, n&
   
2. Sub test2() 'liulang0808 字典凑数 不用字典改成数组版 by kagawa 2018/08/14
   
3.     Dim i&, t&
   
4.    
   
5.     ActiveSheet.UsedRange.Offset(1, 2).ClearContents '清空输出区域
   
6.    
   
7.     m = [a1].End(4).Row - 1 '原始数据个数m
   
8.     a = WorksheetFunction.Transpose([a2].Resize(m)) '读取A2开始的原始数据
   
9.     ReDim b(m) '代替字典 记录凑数组合的数组b
   
10.    
    
11.     h = [b2] 'B2单元格中输入凑数目标和h
    
12.     n = 1 '输出起始行位置
    
13.    
    
14.     Call dg2(0, 0) '递归组合进行凑数
    
15.    
    
16.     MsgBox n '凑数组合结果总数n
    
17. End Sub
    
18. Sub dg2(r&, j&) '递归组合
    
19.     Dim i&, t&
    
20.     For i = j + 1 To m '遍历原始数据中剩余元素
    
21.         t = a(i): b(i) = t '数组b记录当前i位置加入组合的数t
    
22.         If r + t = h Then '累计相加正好相等时 为一组解
    
23.             n = n + 1: Cells(n, 3).Resize(, m) = b '输出解
    
24.         ElseIf r + t < h Then '不足时
    
25.             Call dg2(r + t, i) '继续递归凑数
    
26.         End If
    
27.         b(i) = "" '递归回溯时数组记录中清除当前i位置的数t
    
28.     Next
    
29. End Sub
    
30. 
    

复制代码

我的代码显然更简洁。因为你第一段中的部分，也是可以套用一层递归解决的！
为啥没想到呢？哈哈

香川群子

和我经典的递归凑数程序代码比较，有以下缺点：
1. 超过目标凑数和值h的元素没被事先排除，造成多余计算，影响效率。
2. 重复元素产生的“相同”组合，无法被排除。（如果本来就需要另当别论） 举例 元素值=1是重复的有2个，所以含1的相同组合都会出现 2次。
3. 计算过程没有剪枝、影响效率。
4. 没有使用数组记录输出结果（这个容易改）

以上

香川群子

香川群子 发表于 2018-8-13 11:08
凑数用递归算法是正常的考虑，但是其中使用了字典，会大大降低计算速度。

如果可以，应尽量改用数组进行 ...

我用数组改写了一下，测试结果，就你这16个数据凑10的组合，
使用字典会比使用数组耗时增加60倍！（测试不含输出结果到单元格。）

字典能不用尽量不要用。

鄂龙蒙

请老师帮助，谢谢！
http://club.excelhome.net/thread-1437934-1-1.html

autumnalRain

收藏学习………………………………

autumnalRain

autumnalRain 发表于 2018-9-29 08:22
收藏学习………………………………

呵呵，谢谢老师。身体出问题了

1808835746

好东西，收集了。