在vba中查找所有可能的列表组合

我试图把数据列表“a，b，c，d，e，…”组织到1,2,3 …. n个元素的所有可能的组合中。

例如：

A，B，C，d，电子

a b c d e a,b a,c a,d a,e b,c b,d d,e ... 

等等。

到目前为止，我只遇到了编写代码的人来find两组数据而不是一组数据。

你知道从哪里开始？

在我的脑海中，它将类似于下面的，所以它会系统地运行，并停止任何重复的排列。 所以基本上我会在另一个循环内运行一个循环4或5个不同的时间。

 i i+1 i+...n i,j+1 . . . i,j,k,l.... 

Answer 1

我问了十年前的一个类似的问题，并从约翰·科尔曼那里得到了一个很好的答案：

格雷码

这是他的解决scheme：

 'If you run TestThis, then for example the second message box returns ' '{} 'dog 'dog , cat 'cat 'cat , mouse 'dog , cat, mouse 'dog , mouse 'mouse 'mouse , zebra 'dog , mouse, zebra 'dog , cat, mouse, zebra 'cat , mouse, zebra 'cat , zebra 'dog , cat, zebra 'dog , zebra 'zebra ' 'Hope this helps, ' 'John Coleman 'ps The algorithm used to generate the Gray code comes from the 'excellent book "Combinatorial Algorithms: Generation, Enumeration and 'Search " by Kreher and Stinson." 

和代码：

 Sub TestThis() Dim i As Integer Dim A(3 To 7) As Integer Dim B As Variant For i = 3 To 7 A(i) = i Next i B = Array("dog", "cat", "mouse", "zebra") MsgBox ListSubsets(A) MsgBox ListSubsets(B) End Sub Function ListSubsets(Items As Variant) As String Dim CodeVector() As Integer Dim i As Integer Dim lower As Integer, upper As Integer Dim SubList As String Dim NewSub As String Dim done As Boolean Dim OddStep As Boolean OddStep = True lower = LBound(Items) upper = UBound(Items) ReDim CodeVector(lower To upper) 'it starts all 0 Do Until done 'Add a new subset according to current contents 'of CodeVector NewSub = "" For i = lower To upper If CodeVector(i) = 1 Then If NewSub = "" Then NewSub = Items(i) Else NewSub = NewSub & ", " & Items(i) End If End If Next i If NewSub = "" Then NewSub = "{}" 'empty set SubList = SubList & vbCrLf & NewSub 'now update code vector If OddStep Then 'just flip first bit CodeVector(lower) = 1 - CodeVector(lower) Else 'first locate first 1 i = lower Do While CodeVector(i) <> 1 i = i + 1 Loop 'done if i = upper: If i = upper Then done = True Else 'if not done then flip the *next* bit: i = i + 1 CodeVector(i) = 1 - CodeVector(i) End If End If OddStep = Not OddStep 'toggles between even and odd steps Loop ListSubsets = SubList End Function