第45集 随机抽取
201、 移形换位法（效率最高）
Sub 移形换位演示程序()
Dim arr
Dim x As Integer, num As Integer, k As Integer, srTemp As String
Range(“c1:c10”) = “”
Range(“a1:a10”) = Application.Transpose(Array(“A”, “B”, “C”, “D”, “E”, “F”, “G”, “H”, “I”, “J”))
For x = 1 To 10
num = (Rnd() * ((10 - x + 1) - 1) + 1) \ 1 '生成1~10随机数，\除以1取整
Range(“a1:a” & (10 - x + 1)).Interior.ColorIndex = xlNone
Range(“a” & num).Interior.ColorIndex = 6
Range(“c” & x) = Range(“a” & num)
'下面开始换位
srTemp = Range(“a” & num)
Range(“a” & num) = Range(“a” & (10 - x + 1))
Range(“a” & (10 - x + 1)) = srTemp
Range(“a” & (10 - x + 1)).Interior.ColorIndex = 56
Next x
End Sub
'在换位时数字的换位速度要比文本型要快。所以借力数值型数组达到提速的目的
Sub 移形随机排序()
Dim arr
Dim arr1(1 To 20000, 1 To 1) As String, sr As String
Dim x As Integer, num, t
t = Timer
arr = Range(“a1:a20000”)
For x = 1 To UBound(arr)
num = (Rnd() * ((20000 - x + 1) - 1) + 1) \ 1
arr1(x, 1) = arr(num, 1)
'换位
sr = arr(num, 1)
arr(num, 1) = arr(20000 - x + 1, 1)
arr(20000 - x + 1, 1) = sr
Next x
Range(“c1:c20000”) = “”
Range(“c1:c20000”) = arr1
[d65536].End(xlUp).Offset(1, 0) = Timer - t
End Sub
202、 随机抽取字典法
Sub 移形随机排序升级()
Dim arr
Dim arr1(1 To 20000, 1 To 1) As String, sr As Integer
Dim x As Integer, num, t, y
Dim arr2(1 To 20000)
t = Timer
arr = Range(“a1:a20000”)
For y = 1 To 20000
arr2(y) = y
Next y
For x = 1 To UBound(arr)
num = (Rnd() * ((20000 - x + 1) - 1) + 1) \ 1
arr1(x, 1) = arr(arr2(num), 1)
'换位
sr = arr2(num)
arr2(num) = arr2(20000 - x + 1)
arr2(20000 - x + 1) = num
Next x
Range(“c1:c20000”) = “”
Range(“c1:c20000”) = arr1
[F65536].End(xlUp).Offset(1, 0) = Timer - t
End Sub
Sub 随机抽取字典法()
Dim d As Object
Dim arr, num As Integer, x As Integer, arr1(1 To 20000, 1 To 1) As String, t
t = Timer
Set d = CreateObject(“scripting.dictionary”)
arr = Range(“a1:a20000”)
For x = 1 To 20000
100:
num = Rnd() * (20000 - 1) + 1
If d.exists(num) Then
GoTo 100
Else
d(num) = “” '利用字典key列不重复特点，装入不重复的key值，item列全设置为空
arr1(x, 1) = arr(num, 1)
End If
Next x
Range(“c1:c20000”) = “”
Range(“c1:c20000”) = arr1
[H65536].End(xlUp).Offset(1, 0) = Timer - t
End Sub
