我正在寻找VBA中的代码，以生成传递的数组中所有项目的子集。
I'm looking for code in VBA to generate all subsets of the items in a passed array.
以下是选择所有N选择2个数组大小为N的子集的简单代码。
Below is simple code to select all N choose 2 subsets of array size N.
对于N选择（N-1）...一直到N选择1。
Looking to augment this for N choose (N-1)... all the way down to N choose 1.
Option Base 1 Sub nchoose2() iarray = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10, 11, 12) n = UBound(iarray) x = 1 t = 0 r = 0 Do While (n - x) >= 1 For i = 1 To (n - x) Cells((i + t), 1) = iarray(x) Cells((i + t), 2) = iarray(i + x) Next i x = x + 1 t = t + (n - (1 + r)) r = r + 1 Loop End Sub推荐答案
除了格雷码算法，您还可以利用n元素集的子集与长度为n的二进制向量之间的对应关系。以下代码说明了这种方法：
In addition to the Gray-code algorithm, you can also exploit the correspondence between subsets of an n-element set and binary vectors of length n. The following code illustrates this approach:
Sub AddOne(binaryVector As Variant) 'adds one to an array consisting of 0s and 1s 'thought of as a binary number in little-endian 'the vector is modified in place 'all 1's wraps around to all 0's Dim bit As Long, carry As Long, i As Long, n As Long carry = 1 n = UBound(binaryVector) i = LBound(binaryVector) Do While carry = 1 And i <= n bit = (binaryVector(i) + carry) Mod 2 binaryVector(i) = bit i = i + 1 carry = IIf(bit = 0, 1, 0) Loop End Sub Function listSubsets(items As Variant) As Variant 'returns a variant array of collections Dim lb As Long, ub As Long, i As Long, j As Long, numSets As Long Dim vect As Variant 'binary vector Dim subsets As Variant lb = LBound(items) ub = UBound(items) ReDim vect(lb To ub) numSets = 2 ^ (1 + ub - lb) ReDim subsets(1 To numSets) For i = 1 To numSets Set subsets(i) = New Collection For j = lb To ub If vect(j) = 1 Then subsets(i).Add items(j) Next j AddOne vect Next i listSubsets = subsets End Function Function showCollection(c As Variant) As String Dim v As Variant Dim i As Long, n As Long n = c.Count If n = 0 Then showCollection = "{}" Exit Function End If ReDim v(1 To n) For i = 1 To n v(i) = c(i) Next i showCollection = "{" & Join(v, ", ") & "}" End Function Sub test() Dim stooges As Variant Dim stoogeSets As Variant Dim i As Long stooges = Array("Larry", "Curly", "Moe") stoogeSets = listSubsets(stooges) For i = LBound(stoogeSets) To UBound(stoogeSets) Debug.Print showCollection(stoogeSets(i)) Next i End Sub运行代码结果在以下输出中：
Running the code results in the following output:
{} {Larry} {Curly} {Larry, Curly} {Moe} {Larry, Moe} {Curly, Moe} {Larry, Curly, Moe}