请求大神做一个10选8的所有组合可以显示出来的EXCEL

jym1012

10选8的所有组合可能，10个数字比如1-10   从中任选8个的所有组合可能，一共45种，怎么在excel显示？这10个数字可以自己到时候再改、

gxl19870625

先占个楼层,还没写完.

1. Sub test1()
   
2. Dim arr, i As Integer, j As Integer, k As Integer, m&
   
3. Sheets(1).Cells.Clear
   
4. k = 1
   
5. arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
   
6. For i = 1 To 10
   
7.    For j = 1 To 10
   
8.     arr(i - 1) = ""
   
9.     arr(j - 1) = ""
   
10.     Sheets(1).Cells(k, 1).Resize(1, 10) = arr
    
11.     k = k + 1
    
12.     arr = Array(1, 2, 3, 4, 5, 6, 7, 8, 9, 10)
    
13.    Next j
    
14. Next i
    
15. 
    
16. For m = 1 To Sheets(1).UsedRange.Rows.Count
    
17.   If Application.WorksheetFunction.CountBlank(Sheets(1).Range("A" & m & ":J" & m)) = 1 Then
    
18.    Sheets(1).Cells(m, "K") = 1
    
19.   End If
    
20. Next m
    
21. 
    
22. Sheets(1).Columns("K:K").AutoFilter Field:=1, Criteria1:="<>"
    
23. Sheets(1).Columns("K:K").EntireRow.Delete
    
24. 
    
25. Sheets(1).Range("A1:J" & Sheets(1).UsedRange.Rows.Count).SpecialCells(xlCellTypeBlanks).Delete Shift:=xlToLeft
    
26. 
    
27. Sheets(1).UsedRange.RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7, 8), Header:=xlNo
    
28. 
    
29. End Sub
    

复制代码

gxl19870625

这多天了自己的帖子都不来跟了,这习惯以后谁还帮你?

good8195

gxl19870625 发表于 2015-5-18 18:09
这多天了自己的帖子都不来跟了,这习惯以后谁还帮你?

老師您好,此代碼是只有1-10號而已嗎?

gxl19870625

good8195 发表于 2015-5-18 18:38
老師您好,此代碼是只有1-10號而已嗎?

你看看你原帖说的什么

good8195

gxl19870625 发表于 2015-5-18 20:10
你看看你原帖说的什么

我不是發帖人拉,不過我看不懂他說什麼所以想了解這是幾個數字的組合

gxl19870625

good8195 发表于 2015-5-18 20:23
我不是發帖人拉,不過我看不懂他說什麼所以想了解這是幾個數字的組合

哦,不好意思,没注意,1-10 十选八

Vicel

请测试

1. Sub test()
   
2.     Dim ar, br, cr(), n&, i&, j&, temp
   
3.     ar = [A1:A10]
   
4.     i = LBound(ar)
   
5.     Do
   
6.         j = i + 1
   
7.         Do
   
8.             br = ar
   
9.             br(i, 1) = ""
   
10.             br(j, 1) = ""
    
11.             temp = ""
    
12.             For k = LBound(br) To UBound(br)
    
13.                 If br(k, 1) <> "" Then temp = temp & "," & br(k, 1)
    
14.             Next k
    
15.             n = n + 1
    
16.             ReDim Preserve cr(1 To n)
    
17.             cr(n) = Mid(temp, 2)
    
18.             j = j + 1
    
19.         Loop Until j > UBound(ar)
    
20.         i = i + 1
    
21.     Loop Until i = UBound(ar)
    
22.     [C1].Resize(n, 1) = Application.Transpose(cr)
    
23. End Sub
    

复制代码

test.zip (7.97 KB, 下载次数: 62)

2015-5-18 20:57 上传

点击文件名下载附件

good8195

gxl19870625 发表于 2015-5-18 20:48
哦,不好意思,没注意,1-10 十选八

沒關係,我知道你很怒,難免會誤會
因為我是excel新人,所以我在這邊到處看大家代碼學習
主要是讓自己能看懂,不懂然後再發問

gxl19870625

good8195 发表于 2015-5-18 21:07
沒關係,我知道你很怒,難免會誤會
因為我是excel新人,所以我在這邊到處看大家代碼學習
主要是讓自己能看 ...

学习态度可嘉,给你点赞!不过这个发帖的人态度不咋地,发了求助就消失了.