如何将一个整数有序拆分成指定数量个整数的和（拆分的数可以包含0）

一招秒杀

hubulwm 发表于 2024-6-29 10:09
你好，感谢关注，我相信那是一种非常高效的语句，但如何用VBA来调用呢？还有那个数量都是之前任意指定的 ...

数字个数 和 结果 可以 任意指定，用到了With 通用表达式，没有数据库 无法使用，有就很简单，能轻易调用。

lingshimizi

1. Sub main()
   
2.     GeneratePartitions 2, 4
   
3. End Sub
   
4. Private Function GeneratePartitions(total As Integer, numParts As Integer)
   
5.     Dim result() As Integer
   
6.     ReDim result(1 To numParts) ' 数组用来存储每种拆分的结果
   
7.    
   
8.     ' 调用递归函数生成拆分
   
9.     GeneratePartitionsRecursive total, numParts, 1, result
   
10. End Function
    
11. Private Function GeneratePartitionsRecursive(total As Integer, numParts As Integer, currentPart As Integer, result() As Integer)
    
12.     Dim i As Integer, j As Integer
    
13.    
    
14.     ' 如果当前部分等于总的部分数，则输出结果
    
15.     If currentPart = numParts Then
    
16.         result(currentPart) = total
    
17.         For j = 1 To numParts: Debug.Print result(j);: Next
    
18.         Debug.Print
    
19.     Else
    
20.         ' 生成当前部分的可能性
    
21.         For i = 0 To total
    
22.             result(currentPart) = i
    
23.             ' 递归生成下一个部分
    
24.             GeneratePartitionsRecursive total - i, numParts, currentPart + 1, result
    
25.         Next i
    
26.     End If
    
27. End Function

复制代码

hubulwm

lingshimizi 发表于 2024-6-29 15:47

大佬厉害了，请问如何将结果存放到数组里面然后输出出来？

hubulwm

ynzsvt 发表于 2024-6-29 11:06
这里要除以2，交换后是相同的。

大佬请问，这一句在规模大时候求解提示错误，设置的过大提示内存溢出，有没有自适应的设置这个数的方法呢？
ReDim Brr(1 To 9999, 1 To n)

lingshimizi

1. Private results() As Variant, resultsindex As Long
   
2. Sub main()
   
3.     GeneratePartitions 2, 4
   
4.     Dim i As Long, j As Long, arr()
   
5.     ReDim arr(1 To UBound(results), 1 To UBound(results(1)))
   
6.     For i = 1 To UBound(arr)
   
7.         For j = 1 To UBound(arr, 2)
   
8.             arr(i, j) = results(i)(j)
   
9.         Next
   
10.     Next
    
11.     Cells(1, 1).Resize(UBound(arr), UBound(arr, 2)).Value = arr
    
12. End Sub
    
13. Private Function GeneratePartitions(total As Integer, numParts As Integer)
    
14.     Dim result() As Integer
    
15.     ReDim result(1 To numParts) ' 数组用来存储每种拆分的结果
    
16.     resultsindex = 0
    
17.     ReDim results(1 To 1)
    
18.     ' 调用递归函数生成拆分
    
19.     GeneratePartitionsRecursive total, numParts, 1, result
    
20. End Function
    
21. Private Function GeneratePartitionsRecursive(total As Integer, numParts As Integer, currentPart As Integer, result() As Integer)
    
22.     Dim i As Integer, j As Integer
    
23.    
    
24.     ' 如果当前部分等于总的部分数，则输出结果
    
25.     If currentPart = numParts Then
    
26.         result(currentPart) = total
    
27.         resultsindex = resultsindex + 1
    
28.         ReDim Preserve results(1 To resultsindex)
    
29.         results(resultsindex) = result
    
30.     Else
    
31.         ' 生成当前部分的可能性
    
32.         For i = 0 To total
    
33.             result(currentPart) = i
    
34.             ' 递归生成下一个部分
    
35.             GeneratePartitionsRecursive total - i, numParts, currentPart + 1, result
    
36.         Next i
    
37.     End If
    
38. End Function

复制代码

hubulwm

时间的音符 发表于 2024-6-29 10:58
........................

厉害了，可有实现的代码？

hubulwm

时间的音符 发表于 2024-6-29 19:11
你的数据范围是多少？
最大分的份数是多少？

不限制，希望能把数组输出出来。

hubulwm

时间的音符 发表于 2024-6-29 20:42
你知道我第三张图片下面那一串数字是什么意思嘛？

大佬现在输出的是结果数，需要的是具体的拆分数组