我有下表:
a b c d ...
q w e r ...
z x v ...
p
我在寻找一种算法(最好是 VBA,但其他语言的思维几乎相同)时遇到了很多麻烦,该算法将生成一个包含所有组合的列表 - 除了我只有几行之外,还有很多列,如果手动完成,这不会准确,我相信 VBA 可以使它 100% 完整。
因此,输出应该是这样的列表:
a
a,q
a,z
q,z
z
a/b
a/b,w
a/b,x
a/b,p
a/b,w,x
a/b,w,p
a/b,x,p
a/w
a/w,x
a/w,p
a/x
a/x,p
a/p
a,q/b
a,q/b,w
a,q/b,x
a,q/b,p
a,q/b,w,x
a,q/b,w,p
a,q/b,x,p
a,q/w
a,q/w,x
a,q/w,p
a,q/x
a,q/x,p
a,q/p
....etc.
我并不真正关心“/”和“,”符号,我会找到一种方法来正确放置它们(“/”位于不同列的元素之间,而“,”位于同一列的元素之间)
组合有两种方式 - 水平和垂直,但有以下限制:只能组合“n-1”个元素(水平和/或垂直)
答案1
你的例子表明12项目。此代码(由 John Coleman 于 2005 年提供)将在列中列出列表的 4095 个排列乙. 有 2N - 1 个项目:
Sub MAIN()
B = Array("a", "b", "c", "d", "q", "w", "e", "r", "z", "x", "v", "p")
Call GrayCode(B)
End Sub
Function GrayCode(Items As Variant) As String
Dim CodeVector() As Integer
Dim i, kk 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
kk = 1
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
Cells(kk, 2) = Mid(NewSub, 2)
kk = kk + 1
'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
GrayCode = SubList
End Function
参考:
您可以通过更改来更改/添加/删除项目Array()
。太多将超出列中项目数的限制。