求一个循环组合的算法

lovelfg

一个包含6个元素的数组，(a,b,c,d,e,f),我们知道应该有6！即720种组合，现想要将这所有的组合全部显示在sheet1的A列中，应该如何写呢？

aman1516

~~~~~~

1. Sub test()
   
2. Dim arr As Variant
   
3. Dim brr(1 To 720, 1 To 6)
   
4. Dim dic As Object
   
5. Set dic = CreateObject("Scripting.Dictionary")
   
6. Dim st As String
   
7. Dim s As String
   
8. Do
   
9.     st = "ABCDEF"
   
10.     For j = 6 To 1 Step -1
    
11.         i = Int(VBA.Rnd() * j + 1)
    
12.         s = s & VBA.Mid(st, i, 1)
    
13.         st = Application.WorksheetFunction.Substitute(st, Mid(st, i, 1), "")
    
14.     Next j
    
15.     dic(s) = ""
    
16.     s = ""
    
17. Loop Until dic.Count = 720
    
18. arr = dic.keys
    
19. For m = 1 To 720
    
20.     For n = 1 To 6
    
21.         brr(m, n) = VBA.Mid(arr(m - 1), n, 1)
    
22.     Next n
    
23. Next m
    
24. Range("a1").Resize(720, 6) = brr
    
25. End Sub

复制代码

micch

你这个意思应该是排列吧？循环一下就可以了

lovelfg

micch 发表于 2019-10-15 15:50
你这个意思应该是排列吧？循环一下就可以了

若不考虑字典，如何循环？

micch

lovelfg 发表于 2019-10-15 15:52
若不考虑字典，如何循环？

1. Sub test()
   
2.     x = "ABCDEF"
   
3.     n = 123456
   
4.     Dim ar(719)
   
5.     Do Until n > 654321
   
6.         If InStr(n, 1) * InStr(n, 2) * InStr(n, 3) * InStr(n, 4) * InStr(n, 5) * InStr(n, 6) Then
   
7.             For i = 1 To 6: ar(m) = ar(m) & Mid(x, Mid(n, i, 1), 1): Next
   
8.             m = m + 1
   
9.         End If
   
10.         n = n + 1
    
11.     Loop
    
12.     [a1:a720] = Application.Transpose(ar)
    
13. End Sub
    

复制代码

暴力循环，5W多次，速度慢了点

lovelfg

micch 发表于 2019-10-15 15:57
暴力循环，5W多次，速度慢了点

这方法简直神了！

大灰狼1976

现成的全排列示例给你，差不多这个意思。

月关

笛卡尔积，SQL连接查询时尽量避免出现的，不避免刚好是这个题的解法。
应该一条语句就可以

lovelfg

大灰狼1976 发表于 2019-10-15 16:08
现成的全排列示例给你，差不多这个意思。

这个通用性更高了！

lovelfg

月关 发表于 2019-10-15 16:17
笛卡尔积，SQL连接查询时尽量避免出现的，不避免刚好是这个题的解法。
应该一条语句就可以

应该不是，会产生同一元素被使用两次这种情况吧