学步园

http://topic.csdn.net/u/20110104/19/c7ad4498-5b3c-46cb-a0e5-2cbb080349ea.html

Option Explicit<br /> Dim a() As Single<br /> Dim b() As Long '用于存放a()数组的索引<br /> Dim N As Long '数组元素的个数<br /> Dim MaxValueCounts As Long '筛选最大数值的个数<br /> Private Sub Form_Click()<br /> Dim i As Long, j As Long, k As Long<br /> Dim t1 As Double, t2 As Double<br /> Dim Middle As Long, d As Single<br /> Dim LeftIndex As Long, RightIndex As Long<br /> N = InputBox("请输入将要录入的数据个数", "提示")<br /> MaxValueCounts = InputBox("请输入筛选最大数值的个数", "提示")<br /> ReDim a(N)<br /> ReDim b(MaxValueCounts + 1)</p> <p> Randomize<br /> For i = 1 To N Step 1<br /> a(i) = Rnd<br /> Next i<br /> t1 = Timer</p> <p>'------------------------------从小到大排序-----------------------------<br /> a(0) = -100 '为a(0)预赋一个数组中的最小值<br /> b(0) = 0<br /> b(1) = 1<br /> For i = 2 To N Step 1<br /> 'For j = i - 1 To 0 Step -1<br /> LeftIndex = 1<br /> RightIndex = i - 1<br /> If RightIndex > MaxValueCounts Then RightIndex = MaxValueCounts<br /> Middle = Int((LeftIndex + RightIndex) / 2)<br /> Do<br /> Select Case a(b(Middle))<br /> Case Is = a(i)<br /> For k = MaxValueCounts - 1 To Middle + 1 Step -1<br /> b(k + 1) = b(k)<br /> Next k<br /> b(Middle + 1) = i<br /> Exit Do<br /> Case Is < a(i)<br /> If LeftIndex >= RightIndex Then<br /> For k = MaxValueCounts - 1 To Middle + 1 Step -1<br /> b(k + 1) = b(k)<br /> Next k<br /> b(Middle + 1) = i<br /> Exit Do<br /> End If<br /> LeftIndex = Middle + 1<br /> Case Is > a(i)<br /> If LeftIndex >= RightIndex Then<br /> For k = MaxValueCounts - 1 To Middle Step -1<br /> b(k + 1) = b(k)<br /> Next k<br /> b(Middle) = i<br /> Exit Do<br /> End If<br /> RightIndex = Middle<br /> End Select<br /> Middle = Int((LeftIndex + RightIndex) / 2)<br /> Loop<br /> 'If j = 0 Then a(j) = a(i) - 1 '当a(0)为无穷小时，可以省略该行。<br /> 'If a(i) >= a(b(j)) Then<br /> ' For k = i - 1 To j + 1 Step -1<br /> ' b(k + 1) = b(k)<br /> ' Next k<br /> ' b(j + 1) = i<br /> ' Exit For<br /> 'End If<br /> 'Next j<br /> Next i</p> <p>'-------------------------------完成排序--------------------------------<br /> t2 = Timer<br /> MsgBox t2 - t1<br /> Me.AutoRedraw = True<br /> For i = 1 To MaxValueCounts Step 1<br /> Me.Print a(b(i))<br /> Next i<br /> End Sub<br />  

引用小吉回复：

对于，MaxValueCounts取值，比较大时，可以考虑用CopyMemory代替内层循环后移数据
如：

For k = MaxValueCounts - 1 To Middle + 1 Step -1<br /> b(k + 1) = b(k)<br /> Next k 

可换成

CopyMemory b(Middle + 2), b(Middle + 1), (MaxValueCounts - Middle - 1) * 4 

注意：这样修改后，MaxValueCounts千万不能小于3，否则可能会崩的!!!
在完整排序，即MaxValueCounts=N时，这种变动，能让IDE下的速度一下提高20倍，吓了我一跳！

当然，对N代码编译后，这种修改是无效的，速度提高不足3%，而且，估计在MaxValueCounts取值较小时，可能效率还会下降。
对P代码编译比较实用。