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 ' 当n>32时i的值会溢出!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("A", "B", "C", "D", "E", "F")
GETALL 4, x, out
End Sub
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("A", "B", "C", "D", "E", "F")
GETALL 4, x, out
End Sub