|
关于随机排序,我前段时间也有兴趣研究了一下,思考了3个不同方式。都是以1列数据进行的实验,多列其实也差不多,转换成1维数组就可以用了。
下面是三种思路的实验结果。
1) 循环生成随机数n,用arr(n)创建字典,当数组所有的数都被随机到时,d.Count =UBound(arr),循环结束。这种方法,大概需要随机数组大小的10倍次数,可以把所有的数随机到。
代码如下:
- Sub test1()
- Dim arr, u&, t
- t = Timer
- arr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
- u = UBound(arr)
- Set d = CreateObject("Scripting.Dictionary")
- Do Until d.Count = u
- d(arr(Int(Rnd() * u + 1), 1)) = ""
- Loop
- Range("C1").Resize(u, 1) = Application.Transpose(d.keys)
- Set d = Nothing
- Debug.Print Timer - t
- End Sub
复制代码
代码试验结果:
10000个数据排序用时约0.25-0.3s
50000个数据排序用时约1.3-1.8s 循环次数 45W-60W
2) 循环生成随机数n,将arr(n)赋值给brr(i),然后将arr(n)="",当下一次随机到arr(n)已被取过数(即arr(n)=“”)时,则在arr内上下逐个找到不为空的值。该方法生成随机数的次数为UBound(arr),但因为有时候碰到arr数被取过时需要上下查找,所以会增加很多次另外的循环。
代码为:
- Sub test()
- Dim arr, brr(), i&, j&, n&, u&, k&
- arr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
- u = UBound(arr)
- ReDim brr(1 To u)
- For i = u To 1 Step -1
- n = Int(u * Rnd + 1)
- If arr(n, 1) <> "" Then
- brr(i) = arr(n, 1): arr(n, 1) = ""
- Else
- For j = 1 To Application.Max(n - 1, u - n)
- If n - j >= 1 Then
- If arr(n - j, 1) <> "" Then
- brr(i) = arr(n - j, 1)
- arr(n - j, 1) = ""
- Exit For
- End If
- End If
- If n + j <= u Then
- If arr(n + j, 1) <> "" Then
- brr(i) = arr(n + j, 1): arr(n + j, 1) = ""
- Exit For
- End If
- End If
- Next j
-
- End If
- Next
- Range("C1").Resize(u) = Application.Transpose(brr)
- End Sub
复制代码
代码试验结果:
10000个数据排序用时约0.15-0.3 s
50000个数据排序用时约1.2-2.2s 循环次数 25W-50W
3) 这个方法思路比较简单,就是随机UBound(arr)生成随机数,且随机数的最大值逐步减少至1,每次得到随机数n时将arr(n)赋值给brr(i),并将arr(n)后的数全部前移一格。
这种方法的循环次数是固定的,可以算出来。假设10个数的一维数组,需要移动9×8×7...×1次,如果10000次,则需要循环(10000+1)*5000=50005000
该方法写起来最简单,已最好理解,数少的时候,可能没问题,但数一多,代码运行起来就比较慢了。我试验的时候,10000个数据排序用时约2.5s。
- Sub test3()
- Dim arr, brr(), i&, j&, n&, u&
- arr = Range("A1:A" & Cells(Rows.Count, 1).End(xlUp).Row).Value
- u = UBound(arr)
- ReDim brr(1 To u)
- For i = u To 1 Step -1
- n = Int(i * Rnd + 1)
- brr(i) = arr(n, 1) ': arr(n, 1) = ""
- For j = n To i
- If j = u Then Exit For
- arr(j, 1) = arr(j + 1, 1) ': arr(j + 1, 1) = ""
- Next j
- Next
- Range("C1").Resize(u) = Application.Transpose(brr)
- End Sub
复制代码
|
|