[已解决]33个数中生成不 重复6个数

刀羊

试着做过，现在连文件都没有了。

香川群子

0.1s  即可生成 Combin(33,6) = 1107568 个组合……但已经超过工作表最大行数 1048576行。

mmc998

香川群子 发表于 2014-10-6 10:38
0.1s  即可生成 Combin(33,6) = 1107568 个组合……但已经超过工作表最大行数 1048576行。

做 两个 表可以吗

mmc998

xdragon 发表于 2014-10-5 23:39
最终结果在re这个数组里，由于33选6有110多w组合，一次性无法导出到单元格。如果需要请回复哈

怎么能出来呀

mmc998

xdragon 发表于 2014-10-5 23:39
最终结果在re这个数组里，由于33选6有110多w组合，一次性无法导出到单元格。如果需要请回复哈

需要呀

xdragon

1. Dim ttl%, chs%, rnd_array%(), t_array%(), cbn&, irow&, cnt&
   
2. 
   
3. Sub test()
   
4.    ttl = 5: chs = 3
   
5.    cbn = Application.WorksheetFunction.Combin(ttl, chs)
   
6.    irow = Rows.Count
   
7.    If cbn > irow Then ReDim rnd_array%(1 To irow, 1 To chs) Else ReDim rnd_array%(1 To cbn, 1 To chs)
   
8.    ReDim t_array%(1 To chs)
   
9.    Call dgzh(1, 0)
   
10. End Sub
    
11. 
    
12. Sub dgzh(yn%, n%)
    
13.    Dim i%, j%
    
14.    For i = n + 1 To ttl - chs + yn
    
15.        If yn <= chs Then
    
16.           t_array(yn) = i
    
17.           Call dgzh(yn + 1, i)
    
18.        Else
    
19.           cnt = cnt + 1
    
20.           For j = 1 To chs
    
21.              rnd_array(cnt, j) = t_array(j)
    
22.           Next
    
23.           If cnt Mod irow = 0 Or cnt = cbn Then
    
24.               Call array_to_range
    
25.           End If
    
26.           Exit Sub
    
27.        End If
    
28.    Next
    
29. End Sub
    
30. 
    
31. Sub array_to_range()
    
32.     Static shtcnt%
    
33.     shtcnt = shtcnt + 1
    
34.     If Sheets.Count < shtcnt Then Sheets.Add , Sheets(Sheets.Count)
    
35.     Sheets(shtcnt).Cells.Clear
    
36.     Sheets(shtcnt).Range("A1").Resize(cnt, chs) = rnd_array
    
37.     cbn = cbn - irow
    
38.     If cbn > 0 Then
    
39.        ReDim rnd_array(1 To IIf(cbn > irow, irow, cbn), 1 To UBound(rnd_array, 2))
    
40.     Else
    
41.        shtcnt = 0
    
42.        Erase rnd_array
    
43.     End If
    
44.     cnt = 0
    
45. End Sub
    

复制代码

mmc998

xdragon 发表于 2014-10-7 02:24

怎么用呀

张雄友

xdragon 发表于 2014-10-7 02:24

只在一个表生成可以吗？如达到EXCEL 最大行数 rows.count 时，隔一空列再输出，可以吗？

张雄友

xdragon 发表于 2014-10-7 02:24

16个表就会出现可用资源不足了。

1. Dim ttl&, chs&, rnd_array&(), t_array&(), cbn&, irow&, cnt&
   
2. 
   
3. Sub 多列组合()
   
4.    ttl = 50: chs = 5
   
5.    cbn = Application.WorksheetFunction.Combin(ttl, chs)
   
6.    irow = Rows.Count
   
7.    If cbn > irow Then ReDim rnd_array&(1 To irow, 1 To chs) Else ReDim rnd_array&(1 To cbn, 1 To chs)
   
8.    ReDim t_array&(1 To chs)
   
9.    Call dgzh(1, 0)
   
10. End Sub
    
11. 
    
12. Sub dgzh(yn&, n&)
    
13.    Dim i&, j&
    
14.    For i = n + 1 To ttl - chs + yn
    
15.        If yn <= chs Then
    
16.           t_array(yn) = i
    
17.           Call dgzh(yn + 1, i)
    
18.        Else
    
19.           cnt = cnt + 1
    
20.           For j = 1 To chs
    
21.              rnd_array(cnt, j) = t_array(j)
    
22.           Next
    
23.           If cnt Mod irow = 0 Or cnt = cbn Then
    
24.               Call array_to_range
    
25.           End If
    
26.           Exit Sub
    
27.        End If
    
28.    Next
    
29. End Sub
    
30. 
    
31. Sub array_to_range()
    
32.     Static shtcnt%
    
33.     shtcnt = shtcnt + 1
    
34.     If Sheets.Count < shtcnt Then Sheets.Add , Sheets(Sheets.Count)
    
35.     Sheets(shtcnt).Cells.Clear
    
36.     Sheets(shtcnt).Range("A1").Resize(cnt, chs) = rnd_array
    
37.     cbn = cbn - irow
    
38.     If cbn > 0 Then
    
39.        ReDim rnd_array(1 To IIf(cbn > irow, irow, cbn), 1 To UBound(rnd_array, 2))
    
40.     Else
    
41.        shtcnt = 0
    
42.        Erase rnd_array
    
43.     End If
    
44.     cnt = 0
    
45. End Sub
    

复制代码

xdragon

张雄友 发表于 2014-10-7 22:04
16个表就会出现可用资源不足了。

我这里测试通过了。33个表
如果是列存放的话，可能你的工作表列数不够51选5就会不够了。