[已解决]提出部分数字的全部组合？？

xdwy81129

9-3-8-4-15-6-7-14-17
求解，上面里面提出4个数字的全部组合

例如：9-3-8-4，9-8-3-4算同一个组合（3-4-8-9也算同一个，只显示一个答案），求解所有的组合


数字组合.rar (1.4 KB, 下载次数: 9)

2014-12-21 14:22 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

qh8600

2014-12-21 14:40

1. Dim arr(1 To 4), brr(), k As Long, aa As String, m
   
2. Sub demo()
   
3.     tms = Timer
   
4.     m = Split(Range("a2").Value, "-")
   
5.     ReDim brr(1 To WorksheetFunction.Combin(UBound(m) + 1, 4), 1 To 1)
   
6.     k = 1
   
7.     Call dg(0, 1)
   
8.     MsgBox Format(Timer - tms, "0.00000s ") & UBound(brr) & "个组合"
   
9.     Range("a6").Resize(UBound(brr), 1) = brr
   
10. End Sub
    
11. Sub dg(i As Long, t As Long)
    
12.     Dim j As Long, x As Long
    
13.     For j = i + 1 To 5 + t
    
14.         arr(t) = m(j - 1)
    
15.         aa = Join(arr, "-")
    
16.         If t = 4 Then
    
17.             brr(k, 1) = aa
    
18.             k = k + 1
    
19.         Else
    
20.             Call dg(j, t + 1)
    
21.         End If
    
22.     Next
    
23. End Sub
    

复制代码

附件楼下

跳转到最佳答案楼层

dsmch

1. Sub Macro1()
   
2. Dim arr
   
3. w = Split("9-3-8-4-15-6-7-14-17", "-")
   
4. ReDim arr(1 To UBound(w) ^ 4, 1 To 1)
   
5. For a = 0 To UBound(w) - 3
   
6.     For b = a + 1 To UBound(w) - 2
   
7.         For c = b + 1 To UBound(w) - 1
   
8.             For d = c + 1 To UBound(w)
   
9.                 s = s + 1: arr(s, 1) = w(a) & "-" & w(b) & "-" & w(c) & "-" & w(d)
   
10.             Next
    
11.         Next
    
12.     Next
    
13. Next
    
14. Range("f1").Resize(s) = arr
    
15. End Sub

复制代码

qh8600

1. Dim arr(1 To 4), brr(), k As Long, aa As String, m
   
2. Sub demo()
   
3.     tms = Timer
   
4.     m = Split(Range("a2").Value, "-")
   
5.     ReDim brr(1 To WorksheetFunction.Combin(UBound(m) + 1, 4), 1 To 1)
   
6.     k = 1
   
7.     Call dg(0, 1)
   
8.     MsgBox Format(Timer - tms, "0.00000s ") & UBound(brr) & "个组合"
   
9.     Range("a6").Resize(UBound(brr), 1) = brr
   
10. End Sub
    
11. Sub dg(i As Long, t As Long)
    
12.     Dim j As Long, x As Long
    
13.     For j = i + 1 To 5 + t
    
14.         arr(t) = m(j - 1)
    
15.         aa = Join(arr, "-")
    
16.         If t = 4 Then
    
17.             brr(k, 1) = aa
    
18.             k = k + 1
    
19.         Else
    
20.             Call dg(j, t + 1)
    
21.         End If
    
22.     Next
    
23. End Sub
    

复制代码

附件楼下

qh8600

数字组合.rar (9.25 KB, 下载次数: 7)

2014-12-21 14:41 上传

点击文件名下载附件
楼主试试

huangcaiguang

可不可以用函数写