就目前而言,如果您想查找不同长度或具有不同长度的数组的组合Ubound
,你将不得不改变你的代码。这可能会变得非常乏味并且容易出错。这是一个更通用的解决方案,适用于任何类型、任何大小和任何输出长度的数组。
Sub CombosNoRep(ByRef v() As Variant, r As Long)
Dim i As Long, k As Long, z() As Variant, comboMatrix() As Variant
Dim numRows As Long, numIter As Long, n As Long, count As Long
count = 1
n = UBound(v)
numRows = nChooseK(n, r)
ReDim z(1 To r)
ReDim comboMatrix(1 To numRows, 1 To r)
For i = 1 To r: z(i) = i: Next i
Do While (count <= numRows)
numIter = n - z(r) + 1
For i = 1 To numIter
For k = 1 To r: comboMatrix(count, k) = v(z(k)): Next k
count = count + 1
z(r) = z(r) + 1
Next i
For i = r - 1 To 1 Step -1
If Not (z(i) = (n - r + i)) Then
z(i) = z(i) + 1
For k = (i + 1) To r: z(k) = z(k - 1) + 1: Next k
Exit For
End If
Next i
Loop
Range("A1").Resize(numRows, r).Value2 = comboMatrix
End Sub
Function nChooseK(n As Long, k As Long) As Long
''returns the number of k-combinations from a set
''of n elements. Mathematically speaking, we have: n!/(k!*(n-k)!)
Dim temp As Double, i As Long
temp = 1
For i = 1 To k: temp = temp * (n - k + i) / i: Next i
nChooseK = CLng(temp)
End Function
调用它我们有:
Sub Test()
Dim myArray(1 To 9) As Variant, i As Long
For i = 1 To 9: myArray(i) = i: Next i
Call CombosNoRep(myArray, 6)
End Sub
这会快速输出所有 84 个独特的组合。
让我们在带有字符串的数组上尝试一下。
Sub Test()
Dim myArray() As Variant, i As Long
'' Added blank "" as CombosNoRep is expecting base 1 array
myArray = Array("", "Canada", "England", "Laos", "Ethiopia", "Burma", "Latvia", "Serbia", "Chile", "France", "Tonga")
Call CombosNoRep(myArray, 4)
End Sub
这里我们有国家数组的所有 4 元组(210 个独特的组合)。