不重复不定长度组合

最新推荐文章于 2025-12-18 08:31:44 发布

转载最新推荐文章于 2025-12-18 08:31:44 发布 · 122 阅读

0 ·

CC 4.0 BY-SA版权

原文链接：https://my.oschina.net/tedzheng/blog/1562969

文章标签：

#python

本文介绍了一种使用VBA实现对一组数据进行所有可能的组合，并对每种组合进行求和的方法。通过递归的方式实现了组合的生成，最终将结果输出到Excel的Sheet2中。提供的代码示例展示了如何从Sheet1读取原始数据，递归生成组合及求和，以及如何将结果写回Excel。

2019独角兽企业重金招聘Python工程师标准>>>

具体问题：

求下列数据的所有可能组合，不定长。

101	10
102	20
103	30
104	40
105	50

大概想了一下，可能的组合情况会是如下：

101	10
102	20
103	30
104	40
101102	30
101103	40
101104	50
…
101102103104	100

原数的组合个数将以梯度进行下降，直至驱于1

代码如下，假设原始据在Sheet1,输出到Sheet2

'=============================
'程序：
'   根据原素产生不重复组合
'   并根据组合进行求和
'=============================
'公共变量
Public arr
Public sTmp$
Public nTmp
Public MaxN
Public iCount
Public iOut
Sub Combine()
Dim t
'初始数据
t = Time
iOut = 0
'获取原始数据
'arr = Get_Array_Data
arr = Sheet1.UsedRange
'数据下限
MaxN = UBound(arr)
'递归产生组合
Combine_Recursion 1, 1, MaxN
MsgBox (Time - t)
End Sub

Sub Combine_Recursion(m, n, k)
'递归出口
If m > MaxN Then Exit Sub
'原素组合
sTmp = sTmp & arr(n, 1)
'数据求和
nTmp = nTmp + arr(n, 2)
'原素组合计数
iCount = iCount + 1
Result_Out sTmp, nTmp, iCount
If n < MaxN Then
    Combine_Recursion m, n + 1, k         '循环本层
Else
    sTmp = ""
    nTmp = 0
    iCount = 0
    Combine_Recursion m + 1, m + 1, k     '循环外层
End If
End Sub
'输出数据
Sub Result_Out(a, b, c)
With Sheet2
    iOut = iOut + 1
    .Cells(iOut, 10) = a
    .Cells(iOut, 11) = b
    .Cells(iOut, 12) = c
End With
End Sub

Function Get_Array_Data()
Dim brr
ReDim brr(1 To 5, 1 To 2)
brr(1, 1) = 101: brr(1, 2) = 10
brr(2, 1) = 102: brr(2, 2) = 20
brr(3, 1) = 103: brr(3, 2) = 30
brr(4, 1) = 104: brr(4, 2) = 40
brr(5, 1) = 105: brr(5, 2) = 50
Get_Array_Data = brr
End Function

最后的输出结果如下: