首页
学习
活动
专区
工具
TVP
发布
精选内容/技术社群/优惠产品,尽在小程序
立即前往

不重复不定长度组合

在网上看到相关的贴子,要求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

  • 发表于:
  • 原文链接http://kuaibao.qq.com/s/20180426G18IXP00?refer=cp_1026
  • 腾讯「腾讯云开发者社区」是腾讯内容开放平台帐号(企鹅号)传播渠道之一,根据《腾讯内容开放平台服务协议》转载发布内容。
  • 如有侵权,请联系 cloudcommunity@tencent.com 删除。

扫码

添加站长 进交流群

领取专属 10元无门槛券

私享最新 技术干货

扫码加入开发者社群
领券