Option ExplicitDim Sums(9999) As Long, Sumb(9999) As Long '生成数据数量可自己设置Private blnSort As Boolean '排序方向Private Declare Function SendMessageFind Lib "User32" Alias "SendMessageA" (ByVal hWnd As Long, ByVal wmsg As Long, ByVal wparam As Integer, ByVal lparam As String) As LongPrivate Declare Function timeGetTime Lib "winmm.dll" () As LongDim T As LongPrivate Sub Command1_Click()Dim i As Long, z As Long, j As LongList1.ClearDoEventsList1.Visible = FalseFor i = 0 To UBound(Sums)nn:Randomizez = 99999 * Rnd + 9j = SendMessageFind(List1.hWnd, &H18F, 0, z)If j > -1 ThenGoTo nnElseSums(i) = zSumb(i) = zList1.AddItem Sums(i)End IfNextList1.Visible = TrueMe.Caption = "共产生数据:" & UBound(Sums) + 1 & " 项"End SubPrivate Sub Command2_Click()Dim ti As Integer, i As LongList2.ClearDoEventsFor i = 0 To UBound(Sumb)Sums(i) = Sumb(i)NextblnSort = Option1(0).ValueT = timeGetTimeIf Option2(0).Value = True ThenCall mpsort(Sums) '冒泡排序ti = 0End IfIf Option2(1).Value = True ThenCall insort(Sums) '插入排序ti = 1End IfIf Option2(2).Value = True ThenCall QuickSort(LBound(Sums), UBound(Sums)) '快速排序ti = 2End IfIf Option2(3).Value = True ThenCall selctsort(Sums) '选择排序ti = 3End IfIf Option2(4).Value = True ThenCall hirsort(Sums) '希尔排序ti = 4End IfIf Option2(5).Value = True ThenCall duisort(Sums) '堆排序ti = 5End IfIf Option2(6).Value = True ThenCall nsort(Sums) '打乱次序ti = 6End IfLabel1(ti).Caption = timeGetTime - TList2.Visible = FalseDoEventsFor i = 0 To UBound(Sums)List2.AddItem Sums(i)NextList2.Visible = TrueMe.Caption = "成功对：" & UBound(Sums) + 1 & " 项数据进行了排序,用时: " &Label1(ti).Caption & " 毫秒"Exit SubEnd SubPrivate Sub Command3_Click()List1.ClearList2.ClearMe.Caption = "六种排序"End SubPrivate Sub nsort(ByRef arrtosort() As Long)Dim i As Long, j As Long, tmp As LongFor i = LBound(arrtosort) To UBound(arrtosort)j = (UBound(arrtosort) - i) * Rnd + iIf i <> j Thentmp = arrtosort(i)arrtosort(i) = arrtosort(j)arrtosort(j) = tmpEnd IfNext iEnd SubPrivate Sub mpsort(ByRef arrtosort() As Long) '冒泡排序'经过n-1趟子排序完成的,它的时间复杂度为O（n^2）'优点：1.“编程复杂度”很低，很容易写出代码；2.具有稳定性Dim i As Long, j As Long, M As Long, tmp As LongM = UBound(arrtosort) 'm等于数组上标Do While M '至m等于数组下标j = M - 1M = 0If blnSort ThenFor i = 0 To jIf arrtosort(i) > arrtosort(i + 1) Then '找到后者大于前者地数tmp = arrtosort(i) '两者互换arrtosort(i) = arrtosort(i + 1)arrtosort(i + 1) = tmpM = i '从该位置开始继续查找End IfElseFor i = 0 To jIf arrtosort(i) < arrtosort(i + 1) Thentmp = arrtosort(i)arrtosort(i) = arrtosort(i + 1)arrtosort(i + 1) = tmpM = iEnd IfNext iEnd IfLoopEnd SubPrivate Sub insort(ByRef arrtosort() As Long) '插入排序'插入排序的基本操作就是将一个数据插入到已经排好序的有序数据中,从而得到一个新的、个数加一的有序数据'算法适用于少量数据的排序，时间复杂度为O(n^2)。
是稳定的排序方法。
Dim i As Long, j As Long, k As Long, M As Long, tmp As LongM = UBound(arrtosort)For i = 0 To M '从数组下标到数组上标If blnSort ThenFor j = i + 1 To M '从数组的后一位开始If arrtosort(j) < arrtosort(i) Then '后者大于前者tmp = arrtosort(j)For k = j To i + 1 Step -1 '往后移动数组arrtosort(k) = arrtosort(k - 1)Next karrtosort(i) = tmp '插入该数End IfNext jElseFor j = i + 1 To MIf arrtosort(j) > arrtosort(i) Thentmp = arrtosort(j)For k = j To i + 1 Step -1arrtosort(k) = arrtosort(k - 1)Next karrtosort(i) = tmpNext jEnd IfNext iEnd SubPrivate Sub QuickSort(lngL As Long, lngR As Long) '快速排序,lngL,lngR 需排序数组的下标,上标'快速排序（Quicksort）是对冒泡排序的一种改进。
由C. A. R. Hoare在1962年提出。
'它的基本思想是：通过一趟排序将要排序的数据分割成独立的两部分，其中一部分的所有数据都比另外一部分的所有数据都要小'然后再按此方法对这两部分数据分别进行快速排序，整个排序过程可以递归进行，以此达到整个数据变成有序序列。
Dim i As Long, j As Long, M As Long, tmp As Longi = lngLj = lngRM = Sums((i + j) \ 2)tmp = tCenter(Sums(i), M, Sums(j)) '取轴枢，既作为比较的那个数While i < jIf blnSort ThenWhile i < lngR And Sums(i) < tmp '求lngI使N(i)小于轴枢i = i + 1WendWhile j > lngL And Sums(j) > tmp '求lngJ使N(j)大于轴枢j = j - 1WendElseWhile i < lngR And Sums(i) > tmpi = i + 1WendWhile j > lngL And Sums(j) < tmpj = j - 1WendEnd IfIf i <= j Then '不出错，交换N(i)和N(j) M = Sums(i)Sums(i) = Sums(j)Sums(j) = Mi = i + 1j = j - 1End IfWendIf lngL < j Then: Call QuickSort(lngL, j) '改变位置，递归调用If i < lngR Then: Call QuickSort(i, lngR)End SubPrivate Function tCenter(a As Long, b As Long, C As Long) As Long '取三者中的中间项If a > b Then 'a>bIf b > C Then 'a>b>ctCenter = b 'bElse 'a>b c>=bIf a > C Then 'a>b c>=b a>c tCenter = C 'cElse 'a>b c>=b c>a tCenter = a 'aEnd IfEnd IfElse 'b>=aIf a > C Then 'b>=a a>c tCenter = a 'aElse 'b>=a c>=a If b > C Then 'b>=a c>=a b>c tCenter = C 'cElse 'b>=a c>=a c>=b tCenter = b 'bEnd IfEnd IfEnd IfEnd FunctionPrivate Sub selctsort(ByRef arrtosort() As Long) '选择排序'每一趟从待排序的数据元素中选出最小（或最大）的一个元素，顺序放在已排好序的数列的最后，'直到全部待排序的数据元素排完。