有史以来最快的希尔排序 - 比历史贴快10倍，比Excel排序更快 - 兼论堆排序和快速排序

左岸有贼

果然厉害{:soso_e130:}{:soso_e130:}

叶春晖

学习。。。。

losecher

排序问题没注意过...  学习一下!!

uuubjx

慢慢消化中！

homehomehome

厉害,学习学习

GDGDTAO

学习了，谢谢大师分享

艾姆西希

膜拜，数学不好伤不起

￡Ulikeme

一点都不懂，看得头晕眼花

loquat

1.法师大侠，我拿您的代码出去交流，结果别人给我了一段很简单的快排代码。比您本帖提供的快了将近50%
  我感觉是不是您所做的那些优化没意义了
2.本代码要怎样添加第二个参数，Optional SortUpDown as boolean = true

1. Private Sub QuickSort(ByRef key_arr() As Long, L As Long, R As Long)
   
2.     Dim i As Long, j As Long
   
3.     Dim x As Long, Swap As Long
   
4.     If R - L <= 16 Then
   
5.         For i = L To R
   
6.             x = i
   
7.             For j = i + 1 To R
   
8.                 If key_arr(j) < key_arr(x) Then
   
9.                     x = j
   
10.                 End If
    
11.             Next j
    
12.             
    
13.             If x > i Then
    
14.                 Swap = key_arr(i)
    
15.                 key_arr(i) = key_arr(j)
    
16.                 key_arr(j) = Swap
    
17.             End If
    
18.         Next i
    
19.     Else
    
20.         x = key_arr((L + R) \ 2)
    
21.         i = L
    
22.         j = R
    
23.         Do While i <= j
    
24.             Do While key_arr(i) < x
    
25.                 i = i + 1
    
26.             Loop
    
27.             
    
28.             Do While key_arr(j) > x
    
29.                 j = j - 1
    
30.             Loop
    
31.            
    
32.             If i <= j Then
    
33.                 Swap = key_arr(i)
    
34.                 key_arr(i) = key_arr(j)
    
35.                 key_arr(j) = Swap
    
36.                 i = i + 1
    
37.                 j = j - 1
    
38.             End If
    
39.         Loop
    
40. 
    
41.         '递归方法
    
42.         If (L < j) Then Call QuickSort(key_arr, L, j)
    
43.         If (i < R) Then Call QuickSort(key_arr, i, R)
    
44.     End If
    
45. End Sub
    
46. 
    
47. Public Sub StartSort(ByRef vArray() As Long)
    
48.     Dim iLow As Long
    
49.     Dim iHi As Long
    
50.    
    
51.     '//get range of array
    
52.     iLow = LBound(vArray) '//Low bound
    
53.     iHi = UBound(vArray)  '//High bound
    
54.    
    
55.     '//use STACK, not RECURSION
    
56.     QuickSort vArray(), iLow, iHi   '//call the procedure
    
57.    
    
58. End Sub

复制代码

loquat

请大侠出手释疑本人的电脑上，上楼代码VBA环境下，一下代码的测试时间小于1s

1. Private Sub Command1_Click()
   
2. Dim n() As Long
   
3. m = 1048576
   
4. ReDim n(1 To m)
   
5. For i = 1 To m
   
6.     n(i) = 10000 * Rnd
   
7. Next
   
8. t = Timer
   
9. StartSort n
   
10. debug.print Timer - t
    
11. End Sub

复制代码