不重复不定长度组合

在网上看到相关的贴子，要求n个要素生产的所有的不定长组合，并将相对应的数值相加。

现在有如下数据：

大概想了一下，组合将以下面的情形延展：

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

代码如下(VBA

'=============================

'程序：

' 根据原素产生不重复组合

' 并根据组合进行求和

'=============================

'公共变量

Public arr

Public sTmp$

Public nTmp

Public MaxN

Public iCount

Public iOut

Public iTime

Sub Combine()

Dim t

'初始数据

t = Time

iOut = 0

iTime = 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

'计次

iTime = iTime + 1

Result_Out sTmp, nTmp, iCount, iTime

If n

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, d)

With Sheet2

iOut = iOut + 1

.Cells(iOut, 10) = a

.Cells(iOut, 11) = b

.Cells(iOut, 12) = c

.Cells(iOut, 13) = d

End With

End Sub

Function Get_Array_Data()

Dim brr

ReDim brr(1 To 6, 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

brr(6, 1) = 106: brr(6, 2) = 60

Get_Array_Data = brr

End Function

具体文件可以从下面网盘进行下载

https://pan.baidu.com/s/1hx8TKpHT-espbcSHewb91A