生成不重复随机数的一段代码

水刀梁

1. 借用香川裙子老师的代码，改成自定义函数，这样用起来就方便了。
   
2. 权当向各位前辈高手、大神们致敬了
   
3. Function HugeRndNumbers(Optional ByVal Max As Long = 10, Optional ByVal Min As Long = 1, Optional ByVal N As Integer = 1)
   
4.     Dim a(), b() As Long
   
5.     Dim m, B0, Fd, Cou, i1, i2
   
6.     Cou = Max - Min + 1
   
7.     ReDim b(N - 1)
   
8.     b(0) = Int((2 * Int((Max - b(m) + 1) / (N - m))) * Rnd()) + Min
   
9.     Do While m < N - 1
   
10.        t = Int((2 * Int((Max - b(m) + 1) / (N - m))) * Rnd()) + 1
    
11.        If b(m) + t > Max Then Exit Do
    
12.        m = m + 1
    
13.        b(m) = b(m - 1) + t
    
14.     Loop
    
15.     For i = 1 To N - 1 - m
    
16.       Do Until t1 > 1
    
17.         ct = ct + 1
    
18.         If ct > Max Then
    
19.             If b(0) - Min > 0 Then
    
20.                 t = m + 1
    
21.                 t1 = b(0) - Min
    
22.             Else
    
23.                 For t = 0 To N - 2
    
24.                     If b(t + 1) - b(t) > 1 Then
    
25.                         t1 = b(t + 1) - b(t)
    
26.                         Exit For
    
27.                     End If
    
28.                 Next
    
29.             End If
    
30.             Exit Do
    
31.         End If
    
32.         t = Int((N - 1) * Rnd())
    
33.         t1 = b(t + 1) - b(t)
    
34.       Loop
    
35.       t2 = Int((t1 - 1) * Rnd()) + 1
    
36.       If b(t) + t2 < Min Then
    
37.         MsgBox b(t) + t2
    
38.       Else
    
39.         b(m + 1) = b(t) + t2
    
40.       End If
    
41.     Next
    
42.     For i = N - 1 To 0 Step -1
    
43.       t = Int((i + 1) * Rnd())
    
44.       t1 = b(t)
    
45.       If t1 = 0 Then
    
46.         MsgBox t1
    
47.       End If
    
48.       b(t) = b(i)
    
49.       b(i) = t1
    
50.     Next
    
51.     HugeRndNumbers = b
    
52. End Function

复制代码

水刀梁

1. 这样引用就行了
   
2. Sub TestHugeRndNumbers()
   
3.     Dim Ar() As Long, tm
   
4.     tm = Timer
   
5.     Ar = HugeRndNumbers(100000000, 1, 32767)
   
6.     [E1] = Format(Timer - tm, "0.00")
   
7.     [A5].Resize(32767 ) = ""
   
8.     [A5].Resize(32767) = Application.Transpose(Ar)
   
9. End Sub

复制代码

gaozengxun

这个不错，一定要学习学习。