VBA组合不重复数字输出

laoau138

VBA组合不重复数字输出

A:B列黄底单元格一共模拟5组结果,  每一组有5行不相同数字，每一行有2个不相同数字
所以  从0,1,2,3,4,5,6,7,8,9这10个数字 不断选2个不重复数字组合  分别放入每一组中
每一组,第一行等于C(10,2)=45种
每一组,第二行等于C(8,2)=28种
每一组,第三行等于C(6,2)=15种
每一组,第四行等于C(4,2)=6种
每一组,第五行等于C(2,1)=1种
一共有45*28*15*6*1=113400组(每一组10个数字不能有重复, 每一组有5行，每一行有2个数字)
用按钮控制结果输出      所有组合输出到E:F列绿底单元格   并统计一共有多少组

砂海

听上去像"彩票"

grf1973

运行10秒。

grf1973

改写了一下子函数，1.3秒。

laoau138

grf1973 发表于 2016-10-24 15:05
运行10秒。

VBA随机45组不相同数字                答案好精彩 这个不需要再回答了

香川群子

grf1973 发表于 2016-10-24 16:31
改写了一下子函数，1.3秒。

检查函数应该这么写，速度效率更高一些：

1. If InStr(x, Left(y, 1)) = 0 Then If InStr(x, Right(y, 1)) = 0 Then Check = True

复制代码

比你的少了几个Check = True、Check = False的多余动作。

'    Check = True

'    If InStr(x, Left(y, 1)) > 0 Then Check = False: Exit Function

'    If InStr(x, Right(y, 1)) > 0 Then Check = False

香川群子

代码繁琐一点，但速度效率最高的直接循环、数组检查是否重复。

不含输出时比较，速度快5-6倍。

1. Sub test()
   
2.     Dim a&(9), b(113400, 0), i1&, i2&, i3&, i4&, i5&, i6&, i7&, i8&, i9&, i10&, k&, s$, tms#
   
3.     tms = Timer
   
4.     s = "0123456789"
   
5.     For i1 = 0 To 8
   
6.         a(i1) = 1: Mid(s, 1, 1) = i1
   
7.         For i2 = i1 + 1 To 9
   
8.             a(i2) = 1: Mid(s, 2, 1) = i2
   
9.             
   
10.             For i3 = 0 To 8
    
11.                 If a(i3) = 0 Then
    
12.                     a(i3) = 1: Mid(s, 3, 1) = i3
    
13.                     For i4 = i3 + 1 To 9
    
14.                         If a(i4) = 0 Then
    
15.                             a(i4) = 1: Mid(s, 4, 1) = i4
    
16.                               
    
17.                             For i5 = 0 To 8
    
18.                                 If a(i5) = 0 Then
    
19.                                     a(i5) = 1: Mid(s, 5, 1) = i5
    
20.                                     For i6 = i5 + 1 To 9
    
21.                                         If a(i6) = 0 Then
    
22.                                             a(i6) = 1: Mid(s, 6, 1) = i6
    
23.                                              
    
24.                                             For i7 = 0 To 8
    
25.                                                 If a(i7) = 0 Then
    
26.                                                     a(i7) = 1: Mid(s, 7, 1) = i7
    
27.                                                     For i8 = i7 + 1 To 9
    
28.                                                         If a(i8) = 0 Then
    
29.                                                             a(i8) = 1: Mid(s, 8, 1) = i8
    
30.                                                               
    
31.                                                             For i9 = 0 To 8
    
32.                                                                 If a(i9) = 0 Then
    
33.                                                                     a(i9) = 1: Mid(s, 9, 1) = i9
    
34.                                                                     For i10 = i9 + 1 To 9
    
35.                                                                         If a(i10) = 0 Then
    
36.                                                                             Mid(s, 10, 1) = i10
    
37.                                                                             b(k, 0) = s
    
38.                                                                             k = k + 1
    
39.                                                                         End If
    
40.                                                                     Next
    
41.                                                                     a(i9) = 0
    
42.                                                                 End If
    
43.                                                             Next
    
44.                                                             
    
45.                                                             a(i8) = 0
    
46.                                                         End If
    
47.                                                     Next
    
48.                                                     a(i7) = 0
    
49.                                                 End If
    
50.                                             Next
    
51.                                              
    
52.                                             a(i6) = 0
    
53.                                         End If
    
54.                                     Next
    
55.                                     a(i5) = 0
    
56.                                 End If
    
57.                             Next
    
58.                               
    
59.                             a(i4) = 0
    
60.                         End If
    
61.                     Next
    
62.                     a(i3) = 0
    
63.                 End If
    
64.             Next
    
65.             
    
66.             a(i2) = 0
    
67.         Next
    
68.         a(i1) = 0
    
69.     Next
    
70.     MsgBox Format(Timer - tms, "0.00s ") & k
    
71.     [e:e] = "": [e1].Resize(k) = b
    
72. End Sub

复制代码

香川群子

grf1973 发表于 2016-10-24 16:31
改写了一下子函数，1.3秒。

这个问题该用递归算法，代码就很简单了。但速度效率没有直接循环高。

1. Dim a&(), b(), k&
   
2. Sub test()
   
3.     Dim tms#
   
4.     tms = Timer
   
5.     ReDim a(9), b(113400, 0)
   
6.     k = 0: Call dg("", -1, 0)
   
7.     MsgBox Format(Timer - tms, "0.00s ") & k
   
8.     [e:e] = "": [e1].Resize(k) = b
   
9. End Sub
   
10. Sub dg(s$, i&, t&)
    
11.     If t = 10 Then b(k, 0) = "'" & s: k = k + 1: Exit Sub
    
12.     For i = i + 1 To 9
    
13.         If a(i) = 0 Then a(i) = 1: Call dg(s & i, IIf(t Mod 2, -1, i), t + 1): a(i) = 0
    
14.     Next
    
15. End Sub

复制代码

laoau138

grf1973 发表于 2016-10-24 15:05
运行10秒。

用VBA相同名C列并计单元格   改写数组方法


http://www.excelpx.com/thread-425247-1-1.html

用VBA搜索符合 改写用数组方法

http://www.excelpx.com/thread-425246-1-1.html