12选6的排列组合

赱鋼銯の♂孩

我有A.B.C,D,E,F,G,H,I,J.K.L。12个字母
想把它以A开头做6位数的排列组合
如ABCDEF.ACFGJL.AGHJKL等但是每个组合不能出现相同的六个字母不能重复
向高手讨教怎么用Excel把排列做出来。。。。。。。。

xsy我可以很好

中六保六有很多组合啊

好奇心

1. Sub test()
   
2.     Dim arr(), s As String, s1 As String, brr
   
3.     brr = Array("A", "B", "C", "D", "F", "G", "H", "I", "J", "K", "L", "M")
   
4.     Columns("n").ClearContents
   
5.     For i = 1 To UBound(brr)
   
6.       For j = 1 To UBound(brr)
   
7.         For k = 1 To UBound(brr)
   
8.           For h = 1 To UBound(brr)
   
9.             For n = 1 To UBound(brr)
   
10.               If brr(i) <> brr(j) And brr(i) <> brr(k) And brr(i) <> brr(h) And brr(i) <> brr(n) And _
    
11.                  brr(j) <> brr(k) And brr(j) <> brr(h) And brr(j) <> brr(n) And _
    
12.                  brr(k) <> brr(h) And brr(k) <> brr(n) And brr(h) <> brr(n) Then
    
13.                   m = m + 1
    
14.                   ReDim Preserve arr(1 To m)
    
15.                   arr(m) = brr(0) & brr(i) & brr(j) & brr(k) & brr(h) & brr(n)
    
16.               End If
    
17.             Next
    
18.           Next
    
19.         Next
    
20.       Next
    
21.     Next
    
22.    ' Range("a1:a" & m).NumberFormat = "00000"
    
23.     [a1].Resize(m, 1) = Application.Transpose(arr)
    
24.     Erase arr, brr
    
25.     MsgBox "数据组合完毕。"
    
26. End Sub
    

复制代码

好奇心

字母组合.rar (8.48 KB, 下载次数: 127)

2012-7-9 12:49 上传

点击文件名下载附件

yangyangzhifeng

1. Sub test()
   
2. Dim tt
   
3. tt = Timer
   
4. 
   
5.     Dim xx&, a&, i&, j&, k&, l&, m&, arr, brr
   
6.     xx = WorksheetFunction.Permut(11, 5)
   
7.     ReDim arr(1 To xx, 1 To 1)
   
8.     brr = Array("A", "B", "C", "D", "E", "F", "G", "H", "I", "J", "K", "L")
   
9. 
   
10.     For i = 1 To 11
    
11.      
    
12.         For j = 1 To 11
    
13.             If j <> i Then
    
14.                
    
15.                 For k = 1 To 11
    
16.                     If k <> i And k <> j Then
    
17.                        
    
18.                         For l = 1 To 11
    
19.                             If l <> i And l <> j And l <> k Then
    
20.                               
    
21.                                 For m = 1 To 11
    
22.                                     If m <> i And m <> j And m <> k And m <> l Then
    
23.                                     a = a + 1
    
24.                                         arr(a, 1) = "A" & brr(i) & brr(j) & brr(k) & brr(l) & brr(m)
    
25.                                        
    
26.                                     End If
    
27.                                 Next m
    
28.                             End If
    
29.                         Next l
    
30.                     End If
    
31.                 Next k
    
32.             End If
    
33.         Next j
    
34.     Next i
    
35.     Sheet1.Range("a1").Resize(xx, 1) = arr
    
36.     MsgBox Timer - tt
    
37. End Sub

复制代码

赱鋼銯の♂孩

再此谢过各位大虾啦

bluexuemei

楼主要的是开头为A,其余的5个字母是从剩下11个中选.
请看我的代码:

1. Sub test()
   
2. '须安装ACTIVERUBY.才能运行
   
3. '下载地址  http://www.artonx.org/data/asr/ActiveRuby.msi
   
4. Set x = CreateObject("scriptcontrol"): x.Language = "rubyscript"
   
5. y = x.eval("'BCDEFGHIJKL'.split(//).combination(5).to_a.map{|x|x.unshift('A')}")
   
6. [a1].Resize(UBound(y) + 1, UBound(y, 2) + 1) = y
   
7. Stop
   
8. End Sub

复制代码

bluexuemei

再来一个

1. Sub test1()
   
2. '须安装ACTIVERUBY.才能运行
   
3. '下载地址  http://www.artonx.org/data/asr/ActiveRuby.msi
   
4. t = Timer
   
5. Set x = CreateObject("scriptcontrol"): x.Language = "rubyscript"
   
6. y = x.eval("'ABCDEFGHIJKL'.split(//).combination(6).to_a.map{|x|x if x[0]=='A'}")
   
7. [a1].Resize(UBound(y) + 1, UBound(y, 2) + 1) = y
   
8. MsgBox Timer - t
   
9. End Sub
   

复制代码

赱鋼銯の♂孩

感谢各位大虾的帮助，我在好奇心提供的压缩文件包里找到了解决的办法啦。。。。。再次感谢个位大虾.........

过去的都是影子

亲，好奇心的方法是什么，我下载压缩包什么都没有，能帮忙解释一下吗