|
楼主 |
发表于 2009-10-6 22:57
|
显示全部楼层
[广告] VBA代码宝 - VBA编程加强工具 · VBA代码随查随用 · 内置多项VBA编程加强工具 ★ 免费下载 ★ ★ 使用手册★
排序报时(需要Excel安装语音功能)
'快速排序算法,对字符串数组进行排序
'By:宏fans
'QQ:1158268815
'Date:2009-10-6 22:54:21
'3Q 老朽 for Color VBA Code
Private Sub qsort()
'By:宏fans QQ:1158268815
On Error GoTo erhandler
Dim arr(65000) As String , smg$
Randomize
For I = 0 To 64999
arr(I) = CStr (Rnd)
Next
t = Timer
Call quicksort(arr, 0, UBound (arr))
smg = "排序用时" & Format(Timer - t, "0.000") & "秒"
Debug.Print smg
Application.Speech.Speak smg
Exit Sub
erhandler:
MsgBox Err.Description
End Sub
'By:宏fans
'QQ:1158268815
'Date:2009-10-6 22:54:21
'3Q 老朽 for Color VBA Code
Private Sub quicksort(ByRef arrValue() As String , ByVal intLx As Long , ByVal intRx As Long )
'By:宏fans QQ:1158268815
'arrValue()是待排的数组,intLx,intRx为左右边界
Dim strValue As String
Dim I, j, intLoop As Long
I = intLx
j = intRx
Do
While arrValue(I) <= arrValue(j) And I < j: I = I + 1: Wend
If I < j Then
strValue = arrValue(I)
arrValue(I) = arrValue(j)
arrValue(j) = strValue
End If
While arrValue(I) <= arrValue(j) And I < j: j = j - 1: Wend
If I < j Then
strValue = arrValue(I)
arrValue(I) = arrValue(j)
arrValue(j) = strValue
End If
Loop Until I = j
I = I - 1: j = j + 1
If I > intLx Then
Call quicksort(arrValue, intLx, I)
End If
If j < intRx Then
Call quicksort(arrValue, j, intRx)
End If
End Sub
[ 本帖最后由 zhaozyuan 于 2009-11-24 17:38 编辑 ] |
|