楼主
amulee |
Q：如何列出从1-N的数中取M个数做加法的组合？
A：参考以下代码。- Sub 加法算法()
- Dim arrYS, arrJG, arrTemp
- Dim MyM&, MyN&, i, j, K, iTemp, PoseTemp
- '初始化原始数组
- MyM = [d1]
- ReDim arrYS(1 To MyM)
- For i = 1 To UBound(arrYS)
- arrYS(i) = i
- Next i
- '取出多少个数
- MyN = [d2]
- '初始化临时数组
- ReDim arrTemp(1 To MyM) As Integer
- For i = 1 To MyN
- arrTemp(i) = 1
- Next i
- K = 1
- ReDim arrJG(1 To nx(MyM) / nx(MyN) / nx(MyM - MyN)) '定义结果数组
- arrJG(K) = OutputArrJG(arrYS, arrTemp) '输出第一个结果
- '开始循环
- Do
- '查找10组合，找到就交换
- For i = 1 To MyM - 1
- If arrTemp(i) = 1 And arrTemp(i + 1) = 0 Then
- arrTemp(i) = 0
- arrTemp(i + 1) = 1
- PoseTemp = i
- Exit For
- End If
- Next
- '交换之前的1到最前面
- iTemp = 0
- For i = PoseTemp To 1 Step -1
- If arrTemp(i) = 1 Then
- For j = 1 To PoseTemp
- If arrTemp(j) = 0 Then
- iTemp = j
- Exit For
- End If
- Next j
- If iTemp > i Then Exit For
- arrTemp(iTemp) = 1
- arrTemp(i) = 0
- End If
- Next i
- '输出数组
- K = K + 1
- arrJG(K) = OutputArrJG(arrYS, arrTemp)
- '判断是否结束
- For i = 1 To MyM
- If arrTemp(i) = 1 Then
- iTemp = i
- Exit For
- End If
- Next i
- '判断1是否已经全到右边
- If iTemp > (MyM - MyN) Then Exit Do
- Loop
- '结果输出
- [a2:a65536].ClearContents
- [a2].Resize(UBound(arrJG), 1) = Application.Transpose(arrJG)
- End Sub
- '数组结果输出函数
- Function OutputArrJG(ByVal MyArr, ByVal MyArrTemp)
- Dim strAA As String
- Dim i&
- For i = 1 To UBound(MyArrTemp)
- If MyArrTemp(i) = 1 Then strAA = strAA & MyArr(i) & "+"
- Next i
- strAA = Left(strAA, Len(strAA) - 1)
- OutputArrJG = strAA & "=" & Evaluate(strAA)
- End Function
- Function nx(n)
- Dim i%
- nx = 1
- For i = 2 To n
- nx = nx * i
- Next i
- End Function
 VBA-加法组合.rar
|
2楼
donghan |
哈，楼主好快呀，收藏学习了 |
3楼
donghan |
楼主能不能解释一下啊，我复制完代码还是不懂怎么用 |
4楼
amulee |
工作表内其实有说明，关键是组合的算法
在D1内输入数字总数，在D2内输入取多少个数
组合算法
本程序的思路是开一个数组，其下标表示1到m个数，数组元素的值为1表示其下标
代表的数被选中，为0则没选中。
首先初始化，将数组前n个元素置1，表示第一个组合为前n个数。
然后从左到右扫描数组元素值的“10”组合，找到第一个“10”组合后将其变为
“01”组合，同时将其左边的所有“1”全部移动到数组的最左端。
当第一个“1”移动到数组的m-n的位置，即n个“1”全部移动到最右端时，就得
到了最后一个组合。
例如求5中选3的组合：
1 1 1 0 0 //1,2,3
1 1 0 1 0 //1,2,4
1 0 1 1 0 //1,3,4
0 1 1 1 0 //2,3,4
1 1 0 0 1 //1,2,5
1 0 1 0 1 //1,3,5
0 1 1 0 1 //2,3,5
1 0 0 1 1 //1,4,5
0 1 0 1 1 //2,4,5
0 0 1 1 1 //3,4,5 |
5楼
liuguansky |
不错，学习了。
 |
6楼
赵文竹 |
不错，学习了！但运行时提示有错误“子过程或函数未定义”，请楼主检查一下。谢谢了 |
7楼
donghan |
我也是显示这个提示 |
8楼
donghan |
如果题目改成A1:A10中的10个任意数字该过程可以算么？ |
9楼
amulee |
附件和代码以更新，少了一个计算个数的自定义函数。
如果是A1：A10的数字，也可以通过这个来运算。在那个自定义输出函数里面稍作修改，将其改为A1:A10单元格引用即可。 |
10楼
donghan |
楼主你好，VBA对我来说有点难，想修改你的代码不知道从哪儿修改，再问一下如果取数时数字可以重复，你的代码应该怎样修改呢？ |
11楼
amulee |
两段代码的思路是完全不同的。数字别数太大，不然计算慢。
- Sub 加法算法() '数字可重复
- Dim Nt%, Nm%, i&, j%
- Dim ArrTemp, ArrJG, Temp
- Nt = [D1]
- Nm = [D2]
- ReDim ArrJG(1 To Nt ^ Nm, 0 To 0)
- ReDim ArrTemp(1 To Nm)
- For i = 1 To Nm - 1
- ArrTemp(i) = 1
- Next i
- ArrTemp(Nm) = 0
- For i = 1 To UBound(ArrJG)
- ArrTemp(Nm) = ArrTemp(Nm) + 1
- For j = Nm To 2 Step -1
- If ArrTemp(j) > Nt Then
- ArrTemp(j - 1) = ArrTemp(j - 1) + 1
- ArrTemp(j) = ArrTemp(j) - Nt
- Else
- Exit For
- End If
- Next j
- Temp = Join(ArrTemp, "+")
- ArrJG(i, 0) = Temp & "=" & Evaluate(Temp)
- Next i
- Range("A1:A1048576").Clear
- Range("A1").Resize(UBound(ArrJG), 1) = ArrJG
- End Sub
VBA-加法组合-2.rar
|
12楼
donghan |
下载学习了 |