我的数学知识有限，如果我弄错了，请原谅这些术语。 我需要从多个集合中创建所有可能的组合，其中至少包含一个项目。
- SetA: [1, 2, 3, 4, 5, 6, 7]
- SetB: [a, b, c, d]
- SetC: [!, @, #, $, %]
示例输出：
- [1,a,!]
- [1,2,a,c,@]
- [1,2,3,4,5,6,7,a,b,c,d,!,@,#,$,%]
是否有一个特定的组合公式，因为我只能想出嵌套循环，我不确定它是否正确。
【问题讨论】：
标签： vba excel math combinations
@barrycarter 有一个很好的主意来获得power set。然而，我们不需要拒绝任何东西，因为我们没有得到集合并集的幂集（这最终会变得低效，因为随着集合数量的增加会有很多拒绝）。我们只需获取每个集合的幂集，然后获取这些幂集的所有组合。下面的子程序适用于任意长度的任意数量的集合。
Sub CreateAllCombs()
Dim ArrayOfPowSets() As Variant, mySet() As Variant, ArrCounter() As Long, myPS As Variant
Dim myCombs() As Variant, nextComb() As Variant, ParentComb() As Variant, ArrMax() As Long
Dim i As Long, j As Long, k As Long, count1 As Long, count2 As Long, CombExist As Boolean
Dim tempCol As Long, myMax As Long, maxRow As Long, totalCombs As Long
With ActiveSheet
maxRow = .Cells(.Rows.count, "A").End(xlUp).Row
End With
ReDim ArrayOfSets(1 To maxRow, 1 To 1)
ReDim ArrCounter(1 To maxRow)
ReDim ArrMax(1 To maxRow)
myMax = 0
For i = 1 To maxRow
With ActiveSheet
tempCol = .Cells(i, .Columns.count).End(xlToLeft).Column
End With
ReDim mySet(1 To tempCol)
For j = 1 To tempCol: mySet(j) = Cells(i, j): Next j
myPS = PowerSet(mySet)
ArrMax(i) = UBound(myPS)
If ArrMax(i) > myMax Then
myMax = ArrMax(i)
ReDim Preserve ArrayOfPowSets(1 To maxRow, 1 To ArrMax(i))
End If
For j = 1 To ArrMax(i)
ArrayOfPowSets(i, j) = myPS(j)
Next j
ArrCounter(i) = 1
Next i
CombExist = True
totalCombs = 0
Do While CombExist
count1 = 1
ReDim ParentComb(1 To 1)
For i = 1 To maxRow - 1
For j = 1 To UBound(ArrayOfPowSets(i, ArrCounter(i)))
ReDim Preserve ParentComb(1 To count1)
ParentComb(count1) = ArrayOfPowSets(i, ArrCounter(i))(j)
count1 = count1 + 1
Next j
Next i
For i = 1 To ArrMax(maxRow)
count2 = count1
nextComb = ParentComb
For j = 1 To UBound(ArrayOfPowSets(maxRow, i))
ReDim Preserve nextComb(1 To count2)
nextComb(count2) = ArrayOfPowSets(maxRow, i)(j)
count2 = count2 + 1
Next j
totalCombs = totalCombs + 1
ReDim Preserve myCombs(1 To totalCombs)
myCombs(totalCombs) = nextComb
Next i
k = maxRow - 1
Do While (ArrCounter(k) >= ArrMax(k))
ArrCounter(k) = 1
k = k - 1
If k = 0 Then Exit Do
Loop
If k > 0 Then ArrCounter(k) = ArrCounter(k) + 1 Else CombExist = False
Loop
Sheets("Sheet2").Select
For i = 1 To totalCombs
For j = 1 To UBound(myCombs(i))
Cells(i, j) = myCombs(i)(j)
Next j
Next i
End Sub
我使用了 John Coleman 编写的幂集函数的略微修改版本，发现 here
Function PowerSet(Items As Variant) As Variant
Dim PS As Variant
Dim i As Long, j As Long, k As Long, n As Long
Dim subset() As Variant
n = UBound(Items)
ReDim PS(1 To 1 + 2 ^ n - 2)
For i = 1 To 2 ^ n - 1
ReDim subset(1 To n)
k = 0
For j = 0 To n - 1
If i And 2 ^ j Then
k = k + 1
subset(k) = Items(j + 1)
End If
Next j
ReDim Preserve subset(1 To k)
PS(i) = subset
Next i
PowerSet = PS
End Function
这假设 SetA 在第 1 行，SetB 在第 2 行，等等。观察：
此外，应该警告读者，这可能需要一段时间，因为有超过 1400 万种可能的组合。
(2^3 - 1) * (2^5 - 1) * (2^16 - 1) = 7 * 31 * 65535 = 14221095
此外，所有组合通常都写到Sheet2。
【讨论】：
我想我找到了解决方案，请验证。
首先，对于每个集合，我创建了所有可能的组合，并使用不带空值的帕斯卡三角形之和或以下公式检查长度：
n!/(r!(n-r)!) - 1
例如
SetB: [a, b, c, d] -> [a,b,c,d,ab,ac,ad,bc,bd,cd,abc,abd,acd,bcd,abcd]
在为每个集合创建所有可能的组合之后，我只是使用了乘积规则
[SetA] X [SetB] X [SetC]
所有可能组合的结果：
参考：https://www.mathsisfun.com/combinatorics/combinations-permutations-calculator.html
EDIT1：检查每组的组合数量也可以是 (2^n)-1，其中 n= 组的长度
【讨论】：
2^n - 1。
您是否尝试过使用嵌套的 for 循环。
Sub Hello()
MsgBox ("Hello, world!")
Dim arr1
arr1 = Array("1", "2", "3")
Dim arr2
arr2 = Array("a", "b", "c")
Dim arr3
arr3 = Array("!", "@", "$")
For i = 0 To UBound(arr1)
For j = 0 To UBound(arr2)
For k = 0 To UBound(arr3)
MsgBox (arr1(i) & arr2(j) & arr3(k))
Next
Next
Next
End Sub
【讨论】：