# 非递归解决组合问题

Sub GETALL(ByVal num As Integer, ByRef x As Variant, ByRef RESULT() As String, Optional ByRef all As Long)

Dim A() As String, b() As Integer '临时数组
Dim n As Integer ' 数组元素个数
Dim i As Long '循环变量
Dim TEMP As Long '二进制转换中间变量
Dim num2 As Integer '中间计数变量
n = UBound(x) - LBound(x) + 1 '数组元素个数
If num > n Then MsgBox "ERR!", vbInformation, "WARNING": Exit Sub
ReDim b(0 To n - 1)
all = 0
For i = 0 To 2 ^ n - 1 '循环
TEMP = i
num2 = 0
For j = 0 To n - 1 '转换为二进制
b(j) = TEMP And 1 '0 or 1
TEMP = TEMP / 2
If b(j) = 1 Then
num2 = num2 + 1
ReDim Preserve A(1 To num2)
A(num2) = x(LBound(x) + j)
End If
Next
If num2 = num Then
all = all + 1
ReDim Preserve RESULT(1 To all)
RESULT(all) = Join(A, ",")   '结果保存
Debug.Print RESULT(all) '输出
End If
Next
Debug.Print "从 " & n & " 个元素的数组中选 " & num; " 个元素， 共 " & all & "种组合！"
End Sub

Private Sub Command1_Click()
Dim x, i As Integer
Dim out() As String
x = Array(1, 2, 3, 4, 5, 6, 7, 8)
GETALL 4, x, out
End Sub

1,2,3,4
1,2,3,5
1,2,4,5
1,3,4,5
2,3,4,5
1,2,3,6
1,2,4,6
1,3,4,6
2,3,4,6
1,2,5,6
1,3,5,6
2,3,5,6
1,4,5,6
2,4,5,6
3,4,5,6
1,2,3,7
1,2,4,7
1,3,4,7
2,3,4,7
1,2,5,7
1,3,5,7
2,3,5,7
1,4,5,7
2,4,5,7
3,4,5,7
1,2,6,7
1,3,6,7
2,3,6,7
1,4,6,7
2,4,6,7
3,4,6,7
1,5,6,7
2,5,6,7
3,5,6,7
4,5,6,7
1,2,3,8
1,2,4,8
1,3,4,8
2,3,4,8
1,2,5,8
1,3,5,8
2,3,5,8
1,4,5,8
2,4,5,8
3,4,5,8
1,2,6,8
1,3,6,8
2,3,6,8
1,4,6,8
2,4,6,8
3,4,6,8
1,5,6,8
2,5,6,8
3,5,6,8
4,5,6,8
1,2,7,8
1,3,7,8
2,3,7,8
1,4,7,8
2,4,7,8
3,4,7,8
1,5,7,8
2,5,7,8
3,5,7,8
4,5,7,8
1,6,7,8
2,6,7,8
3,6,7,8
4,6,7,8
5,6,7,8

• 本文已收录于以下专栏：

举报原因： 您举报文章：非递归解决组合问题 色情 政治 抄袭 广告 招聘 骂人 其他 (最多只允许输入30个字)