@VBA
Dictionary全排列组合
如何插入一段漂亮的代码片
代码片
.
Sub test()
Set t1 = CreateObject("Scripting.Dictionary") ''Ôʼ×ÖµäÊý¾Ý
t1.Add 1, "A": t1.Add 2, "B": t1.Add 3, "C": t1.Add 4, "D"
Set rt = CreateObject("Scripting.Dictionary") ''È«ÅÅÁнá¹û
Call compareAll(t1, t1.Count, rt)
k = rt.keys: v = rt.items
For i = 0 To rt.Count - 1
Debug.Print k(i) & " " & v(i)
Next i
End Sub
Function compareAll(ByVal t1 As Object, ByVal zhs As Integer, ByVal rt As Object)
k1 = t1.keys: v1 = t1.items: tCount = t1.Count
For k = 1 To 2 ^ zhs - 1
bitValue = getBitValue(zhs, k): rtString = ""
For i = UBound(bitValue) To 1 Step -1
a = bitValue(i)
If a = 1 Then rtString = rtString + CStr(v1(i - 1))
Next i
rt.Add Join(bitValue, ""), rtString
Next k
End Function
Function getBitValue(ByVal zhs As Integer, ByVal k As Integer)
ReDim arr(1 To zhs)
For i = 1 To zhs
arr(zhs - i + 1) = 1 * Abs(GetBit(k, i))
Next i
''getBitValue = Join(arr, "")
getBitValue = arr
End Function
Function GetBit(ByVal i As Double, ByVal n As Double) As Boolean
GetBit = i And 2 ^ (n - 1)
End Function
输出结果
.
0001 D
0010 C
0011 DC
0100 B
0101 DB
0110 CB
0111 DCB
1000 A
1001 DA
1010 CA
1011 DCA
1100 BA
1101 DBA
1110 CBA
1111 DCBA