2014新年元旦第一强帖：实用凑数凑金额高效递归剪枝算法

香川群子

66327823 发表于 2014-3-30 17:30
川老师，等于100的组合有很多，我想找出1-100这些数只用一次的所有组合。如1+99，2+98，3+97，4+5+6+85，等 ...

这个当然也可以做到，但得到的结果就会是所有有解组合中的不重复组合……

那么，如果你没有一个明确的规则的话，做起来就很伤脑筋……
比如1+99=100用过了以后，那么以后所有含1的组合都不能再用了……这回漏掉很多组合的。

那么，你实际需要的是1 一定要和99组合吗？
还是允许 1+2+97=100呢？


当然，如果你没有任何限制，随便取出一些组合直到剩余最后几个无法组合成=100就算结束。
这样的代码可以有。

香川群子

这个例子就是从一堆数中抽取符合条件的组合，直到剩余元数无法满足求和条件时停止。

但显然这样得到的结果，只是成千上万种所有可能解组合中的一种。

善读书

谢谢楼主提供这个牛的程序 解决了不少问题
请问一下 最终计算出组合 能不能实现 当选定某组合的格子时
该组合格子中 所涉及的数字 其原始表格 都自动高亮呢

haryzbs

学习了，，，

香川群子

善读书 发表于 2014-3-31 12:33
谢谢楼主提供这个牛的程序 解决了不少问题
请问一下 最终计算出组合 能不能实现 当选定某组合的格子时
该 ...

当然可以，而且并不复杂……

选中G列后，激活SelectiChange事件，即可自动分析、查找、高亮该行组合。

…………
但是我在本帖附件中放弃了这个做法，因为如果对象组合元素中有重复时会产生干扰。

香川群子

善读书 发表于 2014-3-31 12:33
谢谢楼主提供这个牛的程序 解决了不少问题
请问一下 最终计算出组合 能不能实现 当选定某组合的格子时
该 ...

1. Private Sub Worksheet_SelectionChange(ByVal Target As Range)
   
2.     If Target.Count > 1 Then Exit Sub
   
3.     If Target.Column <> 8 Then Exit Sub
   
4.     If Target = "" Then Exit Sub
   
5.    
   
6.     m = Range("A1").End(xlDown).Row
   
7.     Range("A1").Resize(m).Interior.ColorIndex = 0
   
8.     If Target.Row = 1 Then Exit Sub
   
9.    
   
10.     sj = Range("A1").Resize(m)
    
11.     Set d = CreateObject("Scripting.Dictionary")
    
12.     For i = m To 2 Step -1
    
13.         d(CStr(sj(i, 1))) = i
    
14.     Next
    
15.    
    
16.     t = Split(Target, "+")
    
17.     For i = 1 To UBound(t)
    
18.         Cells(d(t(i)), 1).Interior.ColorIndex = 6
    
19.     Next
    
20.    
    
21. End Sub

复制代码

你把上边这段代码整体复制、粘贴到Sheet1的代码页中，然后就可以有这个功能了。

使用方法：
1. 组合凑数计算完成后，选中H列（有+号表达式的那一列）
然后A列对应数值就会高亮显示（单元格底色黄色）

2. 选中H1单元格时即可取消A列全部底色


呵呵。自己复制试一试吧。

但是提醒你，如果A列中数据有较多重复，则可能出错。
另外，可能会因为数据小数点显示误差而导致错误。

因为有可能出错，所以我没有加入我的正式程序中。

但你如果自己方便要用，可以自己加进去，做个提醒还是有用处的。

百度不到去谷歌

收藏学习了

592rmb

Ron2000 发表于 2014-1-3 10:07
支持香川大侠，看得出花很多时间整理、说明。加了参数配置，考虑了实际应用的很多情况！
组合计算以外，我的参数设置才是亮点。

一般人考虑不到那么细致的……女生的特长么、心细。
原來想穿裙子老師是大美女呀，佩服

DZ潇潇

V盲表弟也来收藏此宝帖。

海婷

确实是一种通用的方法，多谢！！！