关于组合数字相加之和等于56的解题思路分享

楼主 kevinchengcw	本题的难点在于数字组合的个数不定，所以没有办法利用确定的变量来完成，在本例中运用了字典与数组相结合的方式对数字进行组合，思路说明如下： 1. 获得数据区域，并设置循环进行取数; 2. 利用字典存储相关数据，key存序号，item存数值，Dic用来存储全部数字，Dic2用于存储当前加和数字，当Dic2中的数值匹配时从Dic里移除对应的值，这样Dic最终剩余的是不能匹配的数值; 3. 记住累加的数的起始位置，向下方累加，当累加之和与56的差值介于数据区的最小值与最大值之间时，向下方未累加的数据区寻找一个刚好与现有加和值相加等于56的数字; 4. 如果未找到，自动放弃起始位置的数字，起始位置下移，再重复3的步骤; 5. 找到符合的组合后，将字典中内容输出到指定区域，并从Dic里移除对应数值; 6. 将最终无法匹配的数据(即Dic里剩余的数字)输出在最后。代码如下： Sub test() Dim Dic, Dic2, Arr, Arr2 Dim M, N, I, A, B, X, Y As Integer Dim WF On Error GoTo finish '之所以设置这个是因为最终剩余的值组合没办法符合要求的时候没办法清空数组，所以利用二次添加出错跳出循环 X = 4 '数据输出的起始列号 Y = 6 '数据输出的起始行号 B = 0 '行数增加的次数 Set WF = WorksheetFunction Set Dic = CreateObject("scripting.dictionary") '创建字典 Set Dic2 = CreateObject("scripting.dictionary") For M = 2 To [a65536].End(3).Row '循环将数据区数据存入字典中，以序号为Key，对应数值为Item Dic.Add Cells(M, 1).Value, Cells(M, 2).Value Next M Do While WF.Sum(Dic.items) >= 56 '设置循环为当字典加和大于56时重复循环 Arr = Dic.keys '将字典的keys赋值给数组，便于循环取用 M = 0 '用于存储加和的变量初始赋值 For I = LBound(Arr) To UBound(Arr) '循环相加字典中对应的数值 M = M + Dic(Arr(I)) Dic2.Add Arr(I), Dic(Arr(I)) '并将已相加过的数据赋值给字典2（如果相加和等于56后便于删除字典中的对应项） If 56 - M <= WF.Max(Dic.items) And 56 - M >= WF.Min(Dic.items) Then '当加和与56的差小于或等于现有值序列的最大值且大于或等于现有值序列的最小值时进入内循环 For N = I + 1 To UBound(Arr) '内循环从当前索引值的下一个开始到最后 If M + Dic.Item(Arr(N)) = 56 Then '逐个相加测试，如果所得值等于56，则 Dic2.Add Arr(N), Dic(Arr(N)) '先将适合的值的信息加入到字典2 Arr2 = Dic2.keys '将字典2的keys赋值给数组2 Cells(Y - 1, X) = "序号" '输出数据的标题 Cells(Y - 1, X + 1) = "数值" For A = LBound(Arr2) To UBound(Arr2) '循环输出合格的数据信息 Cells(Y, X) = Arr2(A) Cells(Y, X).Offset(0, 1) = Dic2(Arr2(A)) Y = Y + 1 Dic.Remove Arr2(A) '删除字典中的已输出项目 Next A Erase Arr2 '清空数组2 Dic2.RemoveAll '清空字典2 X = X + 3 '改变输出数据的位置数据 If X > 14 Then B = B + 1 X = 4 End If Y = 6 + 14 * B GoTo skip '执行完上述动作后跳转到下一次循环 End If Next N End If Next I skip: Loop finish: '当剩余数据无法符合进二次操作字典添加出错会跳转到此，则此时可完成剩余数值处理工作 Cells(Y - 1, X) = "序号" '输出数据标题 Cells(Y - 1, X + 1) = "未用数" For N = LBound(Arr) To UBound(Arr) '循环将剩余数据输出 Cells(Y, X) = Arr(N) Cells(Y, X + 1) = Dic(Arr(N)) Y = Y + 1 Next N Set Dic = Nothing '清除项目 Set Dic2 = Nothing MsgBox "组合查找完毕" '显示提示框 End Sub 具体内容详见附件。求数值组合之和为56.rar
2楼 shibo79	好像这个VBA 不可以实用于SINGLE数值，当100个数都是由含有小数的数据组成时，函数只能执行一次，无法进入循环，楼主不防试一试
3楼 shibo79	数例重新上传，请楼主或高手看看能否实现求数值组合之和为56修改数例.rar
4楼 kevinchengcw	对于数值差过大的数现在确实没有良好解决，因为这可能涉及到各数值之间需要间隔很多行，暂时想到的唯穷举法一途了，不知楼上有何高见
5楼 wangqilong1980	好,支持一下小7~
6楼 liuguansky	楼上的有才啊
7楼吉七儿
8楼 wqfzqgk	测试有小数时有点缺陷
9楼 xyh9999	学习K哥的思路
10楼 wise	学习了
11楼 gouweicao78	7粉，你这让K哥情何以堪啊
12楼 poiuyman5	interesting.