凑数代码喜添丁

不规则结构

     vba天下苦凑数久矣，直至香川群子修剪代码问世，世人惊叹"天花板的存在"。今有代码小兵，不揣冒昧称"我也会写"，洒家不信，上机居然运行不爽。这是凑数代码的"月亮之上"，还是华为套壳的魔改，是新手村的毕业宣言，还是换汤不换药的老戏新唱？

     以上戏言，博疫情之困的朋友一笑。代码是群友写的，群友是编程爱好者，除了VBA还在学习js for wps。婉转地说，这段代码无法替代裙子老师作品，最明显的是代码未考虑最接近目标数。

micch

1. Option Explicit
   
2.    
   
3. Sub main()
   
4.     Dim t As Double, half As Integer, count As Long, stackSum As Integer, prevNums(), results(), num As Integer
   
5.     t = Timer
   
6.     ReDim results(1 To Rows.count, 1 To 1)
   
7.    
   
8.     Const sum = 100, startNum = 1
   
9.     half = -Int(-sum / 2)
   
10.     prevNums = Array(startNum, 0)
    
11.    
    
12.     With VBA.CreateObject("Scripting.Dictionary")
    
13.         .Add startNum, ""
    
14.         Do While True
    
15.             num = prevNums(0)
    
16.             prevNums(1) = stackSum
    
17.             stackSum = stackSum + num
    
18.             If stackSum = sum Then
    
19.                 count = count + 1
    
20.                 results(count, 1) = VBA.Join(.keys(), ",")
    
21.                 If num = sum Then Exit Do
    
22.                 .Remove num
    
23.                 num = .keys()(.count - 1)
    
24.                 .Remove num
    
25.                 stackSum = prevNums(1) - num
    
26.                 num = num + 1
    
27.                 If num >= half And .count = 0 Then num = sum
    
28.             ElseIf num < sum - stackSum Then
    
29.                 num = num + 1
    
30.             Else
    
31.                 .Remove num
    
32.                 stackSum = prevNums(1)
    
33.                 num = sum - stackSum
    
34.             End If
    
35.             prevNums(0) = num
    
36.             .Add num, ""
    
37.         Loop
    
38.     End With
    
39.    
    
40.    
    
41.     Columns(1).ClearContents: Range("A1").Resize(count, 1).Value = results
    
42.     Range("B1") = "结果集：" & count & "个、耗时：" & Timer - t & "秒"
    
43. End Sub
    

复制代码

今铭昔

哈哈，还真上传到EH了

明天会更好zj

哈哈哈哈哈哈哈！

熊文来

这个凑数主要是用在日常哪些方面呢？

学不完用不尽

强大！！！

今铭昔

熊文来 发表于 2022-12-26 08:47
这个凑数主要是用在日常哪些方面呢？

这个算法是我写的，就是在1到100中枚举出全部能求和为100的不重复数字组合，这就是这个代码的功能。

其实真正妙的是我的凑数算法思路，也是想了好久的，根据这个算法思路，我写出了很多有意思的玩意，计算33选6的全部组合，1、2、3这3个元素的所有组合，以及实现了香川裙子大佬的递归凑数算法的功能。

aman1516

厉害了，来粘点技术大师们的仙气
谢谢分享

leolee82

居然还有活跃的群，我的VBA群基本上一年多才有人冒个泡

morpheus126

坐等神仙打架，感谢分享