40列每列5行，每列只选一个数字，请帮我列出所有排序结果

yqlg2000

40列每列5行，每列只选一个数字，请帮我列出所有排序结果。
如：
A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1 O1 P1 Q1 R1 S1 T1 U1 V1 W1 X1 Y1 Z1 AA1 AB1 AC1 AD1 AE1 AF1 AG1 AH1 AI1 AJ1 AK1 AL1 AM1 AN1
A1 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1 O1 P1 Q1 R1 S1 T1 U1 V1 W1 X1 Y1 Z1 AA1 AB1 AC1 AD1 AE1 AF1 AG1 AH1 AI1 AJ1 AK1 AL1 AM1 AN2
...
A2 B1 C1 D1 E1 F1 G1 H1 I1 J1 K1 L1 M1 N1 O1 P1 Q1 R1 S1 T1 U1 V1 W1 X1 Y1 Z1 AA1 AB1 AC1 AD1 AE1 AF1 AG1 AH1 AI1 AJ1 AK1 AL1 AM1 AN1
...
按排序公式,一共有
5
C40 =(40*39*38*37*36)/(5*4*3*2*1)=658008 个组合
请帮忙把组合结果发上来。谢谢！

roych

1. Sub test()
   
2. Dim d As Object
   
3. Set d = CreateObject("Scripting.Dictionary")
   
4. Dim i, j, k, l, m, n, s
   
5. arr = Sheet1.Range("a1:h1")
   
6. For i = 1 To UBound(arr, 2)
   
7.     For j = i + 1 To UBound(arr, 2)
   
8.         For k = j + 1 To UBound(arr, 2)
   
9.             For l = k + 1 To UBound(arr, 2)
   
10.                 For m = l + 1 To UBound(arr, 2)
    
11.                     n = arr(1, i) & "-" & arr(1, j) & "-" & arr(1, k) & "-" & arr(1, l) & "-" & arr(1, m)
    
12.                     d.Add n, n
    
13.                 Next
    
14.             Next
    
15.         Next
    
16.     Next
    
17. Next
    
18. Sheet2.[a1].Resize(d.Count, 1) = Application.Transpose(d.Keys)
    
19. End Sub

复制代码

不过，太多数据的话，运行起来估计不太好~~~