求整数拆分组合

香川群子

发现一个有趣的题目。

来源于以前发放纸币工资时，往往需要准备各种小面额零散币值分给大家，

于是，希望知道对一个整数，到底能拆分成总额相等的多少种组合，产生了兴趣。


题目是这的：

有一笔余额，比如说是438元，那么，可以有多少种不同的纸币组合呢？

比如，可分成，100元4张+20元1张+10元一张+5元1张+2元1张+1元1张=438元，

也可以分成：100元1张+50元3张+10元15张+10元2张+1元18张

甚至直接分成1元438张。



…………
请有兴趣的坛友，编程序列出所有组合解。



题目不算难，关键是看算法。



呵呵。期待高手的简洁高效代码。




最后，数学化重申题目要求是：
对于事先给定的1个整数金额（其取值范围为 1-454元）
求按照 1,2,5,10,20,50,100这7种面值纸币的全部拆分组合。


…………
限定取值范围上限454元，是因为其组合数已经达到65190，再大下去计算的意义不大了。

风云际会6

我也想知道

灰袍法师

这个没什么好玩的
《组合数学》有公式直接计算组合总数
1/(1-x^100)/(1-x^50)/(1-x^20)/(1-x^10)/(1-x^5)/(1-x^2)/(1-x)
将上式泰勒展开，展开式中x^454的系数即为组合总数
http://club.excelhome.net/thread-688906-1-1.html 看九楼
当然，编程列举全部的话，又是一堆循环了。。。。。。要速度快还是不容易的。

香川群子

呵呵，我只要编程列举全部就好了。……所以，不用思考很大很大数字的拆分，能拆分小于454的就足够了。



要看代码。

香川群子

帖子沉的很快啊。

香川群子

自己顶！

1. Sub DivNum()
   
2.     a = Array(1, 2, 5, 10, 20, 50, 100) 'm<=194 (64,443)
   
3.    
   
4.     m = [m1]
   
5.     If m <= 0 Or m > 194 Then
   
6.         m = InputBox("m<=194 (64,443):", "Input Sum")
   
7.         If m = "" Then Exit Sub Else m = Val(m)
   
8.     End If
   
9.    
   
10.     For n = UBound(a) To 0 Step -1
    
11.         If m >= a(n) Then Exit For
    
12.     Next
    
13.    
    
14.     ReDim b(n)
    
15.     ReDim c(n + 1, 65535)
    
16.     b(0) = m
    
17.     For i = n To 1 Step -1
    
18.         b(i) = b(0) \ a(i)
    
19.         b(0) = b(0) Mod a(i)
    
20.     Next
    
21.    
    
22.     For j = 1 To 65534
    
23.         For i = 0 To n
    
24.             If b(i) > 0 Then
    
25.                 c(i, j) = b(i)
    
26.                 c(n + 1, j) = c(n + 1, j) & "+" & a(i) & "*" & b(i)
    
27.             End If
    
28.         Next
    
29. '        Mid(c(n + 1, j), 1, 1) = "="
    
30.                
    
31.         For i = 1 To n
    
32.             If b(i) > 0 Then
    
33.                 b(i) = b(i) - 1
    
34.                 b(0) = b(0) + a(i)
    
35.                 For k = i - 1 To 1 Step -1
    
36.                     b(k) = b(0) \ a(k)
    
37.                     b(0) = b(0) Mod a(k)
    
38.                 Next
    
39.                
    
40.                 GoTo Nxt
    
41.             End If
    
42.         Next
    
43.         GoTo Ext
    
44. Nxt:
    
45.     Next
    
46.     MsgBox "Over ! ": Exit Sub
    
47. Ext:
    
48.     For i = 0 To n
    
49.         c(i, 0) = a(i)
    
50.     Next
    
51.     c(n + 1, 0) = j
    
52.     ReDim Preserve c(n + 1, j)
    
53.     [a1].CurrentRegion.Clear
    
54.     [a1].Resize(j + 1, n + 2) = WorksheetFunction.Transpose(c)
    
55.    
    
56. End Sub
    

复制代码

香川群子

tianmashi 发表于 2012-3-22 20:25
老师您好，我想麻烦您一下，我有个疑问，附件里的表2是做好的，我想变动一下，程序应该怎么修改呢？

即 ...

代码帮你写好了。实际上没有什么难度。
只要会计算相应数组坐标位置就可以了。

1. Sub test()
   
2.     rw = Cells(65536, Range("data").Column).End(3).Row + 1
   
3.     cl = Range("data").End(2).Column - Range("data").Column
   
4.     arr = [b2].Resize(rw, cl)
   
5.    
   
6.     n = Cells(65536, Range("input").Column + 1).End(3).Row - 1
   
7.     brr = Range("input").Offset(1, 1).Resize(n, 2)
   
8.    
   
9.     ReDim crr1(n * 3, 0)
   
10.     ReDim crr2(cl * 3 * 3, (rw / 3 - 1) \ 3)
    
11.     ReDim k2((rw / 3 - 1) \ 3)
    
12.     ReDim crr3(cl * 3 * 39, (rw / 3 - 1) \ 39)
    
13.     ReDim k3((rw / 3 - 1) \ 39)
    
14.    
    
15.     For i = 1 To n
    
16.         x = Val(brr(i, 1)) - 1
    
17.         y = Val(brr(i, 2))
    
18.         t1 = arr(x * 3 + 1, y)
    
19.         t2 = arr(x * 3 + 2, y)
    
20.         
    
21.         crr1(k1, 0) = t1
    
22.         crr1(k1 + 1, 0) = t2
    
23.         k1 = k1 + 3
    
24.         
    
25.         j2 = x \ 3
    
26.         crr2(k2(j2), j2) = t1
    
27.         crr2(k2(j2) + 1, j2) = t2
    
28.         k2(j2) = k2(j2) + 3
    
29.         
    
30.         j3 = x \ 39
    
31.         crr3(k3(j3), j3) = t1
    
32.         crr3(k3(j3) + 1, j3) = t2
    
33.         k3(j3) = k3(j3) + 3
    
34.         
    
35.     Next
    
36.    
    
37.     Range("output1").Offset(1, 1).Resize(k1) = crr1
    
38.     t2 = Application.Large(k2, 1)
    
39.     Range("output2").Offset(1, 1).Resize(t2, UBound(crr2, 2) + 1) = crr2
    
40.     t3 = Application.Large(k3, 1)
    
41.     Range("output3").Offset(1, 1).Resize(t3, UBound(crr3, 2) + 1) = crr3
    
42. End Sub
    

复制代码

香川群子

请看附件。

由于文件和代码中使用了范围名称，所以需要使用我的附件。

tianmashi

香川群子 发表于 2011-11-24 12:36
自己顶！

老师，您帮我看看吧。

tianmashi

香川群子 发表于 2011-11-24 12:36
自己顶！

老师您好，我想麻烦您一下，我有个疑问，附件里的表2是做好的，我想变动一下，程序应该怎么修改呢？

即由表1,2如何得出表3，4？多谢您了！！

附件如下：

显示名单的转化3.rar (20.27 KB, 下载次数: 23)

2012-3-22 20:25 上传

点击文件名下载附件