Sub 随机挑选演示程序1()
Dim arr
Dim x As Integer, num As Integer, k As Integer
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 - 1) + 1) \ 1
Range('a1:a10').Interior.ColorIndex = xlNone
Range('a' & num).Interior.ColorIndex = 6
Range('c' & x) = Range('a' & num)
Next x
End Sub
Sub 移形换位演示程序()
Dim arr
Dim x As Integer, num As Integer, k As Integer, sr 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
Range('a1:a' & (10 - x + 1)).Interior.ColorIndex = xlNone
Range('a' & num).Interior.ColorIndex = 6
Range('c' & x) = Range('a' & num)
'下面开始换位
sr = Range('a' & num)
Range('a' & num) = Range('a' & (10 - x + 1))
Range('a' & (10 - x + 1)) = sr
Range('a' & (10 - x + 1)).Interior.ColorIndex = 1
Next x
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) = ''
arr1(x, 1) = arr(num, 1)
End If
Next x
Range('c1:c20000') = ''
Range('c1:c20000') = arr1
[d65536].End(xlUp).Offset(1, 0) = Timer - t
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
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