利用工作表单元格排序才是王道？

LIUZHU

在网上看到了用JavaScript的sort方法进行排序，并与单元格排序对比了下，测试500000个随机数从小到大排序，感觉JavaScript被完爆啊，有没有比单元格排序更快的方法？
测试结果：
JavaScript排序：13秒
单元格排序：3秒

1. '测试500000个数据的排序时间为13秒。
   
2. 
   
3. Sub Java数值排序速度测试()
   
4.     Dim Js As New ScriptControl
   
5.     Dim Arr, kk$, Brr()
   
6.     Dim i&, t1#, t2#
   
7.    
   
8.    
   
9.     Application.ScreenUpdating = False
   
10.     Application.DisplayAlerts = False
    
11.    
    
12.     t1 = Timer
    
13.     ReDim Arr(1 To 500000)
    
14.    
    
15.     For i = 1 To UBound(Arr)
    
16.         Arr(i) = Rnd * 10000
    
17.     Next i
    
18.    
    
19.     kk = Join(Arr, ",")
    
20.    
    
21.     With Js
    
22.         .Language = "JavaScript"
    
23.         
    
24.         .AddCode "function aa(bb){x=bb.split(',');x.sort(function(a,b){return a-b});return x;}"
    
25.         
    
26.         Arr = Split(.Eval("aa('" & kk & "')"), ",")
    
27.     End With
    
28.    
    
29.     ReDim Brr(1 To UBound(Arr) + 1, 1 To 1)
    
30.    
    
31.     For i = 0 To UBound(Arr)
    
32.         Brr(i + 1, 1) = Arr(i)
    
33.     Next i
    
34.    
    
35.      With ActiveSheet.Range("B1").Resize(UBound(Brr), 1)
    
36.         .ClearContents
    
37.         .Value = Brr
    
38.     End With
    
39. 
    
40.     t2 = Timer
    
41.    
    
42.     Application.ScreenUpdating = True
    
43.     Application.DisplayAlerts = True
    
44.    
    
45.     MsgBox "用时：" & Round(t2 - t1, 0) & "秒。"
    
46. End Sub
    
47. 
    
48. 
    
49. '测试500000个数据的排序时间为3秒。
    
50. 
    
51. Sub 单元格排序速度测试()
    
52.     Dim Arr()
    
53.     Dim i&, t1#, t2#
    
54.    
    
55.     t1 = Timer
    
56.     ReDim Arr(1 To 500000, 1 To 1)
    
57.    
    
58.     For i = 1 To UBound(Arr)
    
59.         Arr(i, 1) = Rnd * 10000
    
60.     Next i
    
61.    
    
62.     Application.ScreenUpdating = False
    
63.     Application.DisplayAlerts = False
    
64.    
    
65.     With Sheets.Add(before:=Sheets(1))
    
66.         With .Range("C1").Resize(UBound(Arr), 1)
    
67.             .Value = Arr
    
68.             .Sort key1:=ActiveSheet.Range("C1")
    
69.             Arr = .Value
    
70.         End With
    
71.         .Delete
    
72.     End With
    
73.    
    
74.     With Sheets("Sheet1").Range("C1").Resize(UBound(Arr), 1)
    
75.         .EntireColumn.ClearContents
    
76.         .Value = Arr
    
77.     End With
    
78. 
    
79.     t2 = Timer
    
80.     Application.ScreenUpdating = True
    
81.     Application.DisplayAlerts = True
    
82.     MsgBox "用时：" & Round(t2 - t1, 0) & "秒。"
    
83. End Sub

复制代码

jiminyanyan

13 秒也能接受呀。。。。。

duquancai

Sub k排序速度测试()
    Dim Arr, Brr(), i&, t1#, t2#
    t1 = Timer
    ReDim Arr(1 To 500000)
    For i = 1 To UBound(Arr)
        Arr(i) = Rnd * 10000
    Next
    Call QuickSort(Arr, 1, 500000)
    ReDim Brr(1 To 500000, 1 To 1)
    For i = 1 To 500000
        Brr(i, 1) = Arr(i)
    Next
    With ActiveSheet.Range("B1").Resize(500000, 1)
        .ClearContents
        .Value = Brr
    End With
    t2 = Timer
    MsgBox "用时：" & Round(t2 - t1, 0) & "秒。"
End Sub
Function QuickSort(ar, l&, u&)
    Dim i&, j&, x, t
    x = ar(l): i = l + 1: j = u
    Do While i <= j
        Do While i < u
            If ar(i) > x Then Exit Do Else i = i + 1
        Loop
        Do While j > l
            If ar(j) < x Then Exit Do Else j = j - 1
        Loop
        If i < j Then t = ar(i): ar(i) = ar(j): ar(j) = t Else Exit Do
    Loop
    If j > l Then t = ar(l): ar(l) = ar(j): ar(j) = t: Call QuickSort(ar, l, j)
    If j + 1 < u Then Call QuickSort(ar, j + 1, u)
End Function

songdg

试一试桶排序http://club.excelhome.net/thread-1335003-2-1.html

LIUZHU

duquancai 发表于 2017-6-14 21:35
Sub k排序速度测试()
    Dim Arr, Brr(), i&, t1#, t2#
    t1 = Timer

什么原理？

LIUZHU

songdg 发表于 2017-6-15 09:56
试一试桶排序http://club.excelhome.net/thread-1335003-2-1.html

请告知下桶排序的原理？

duquancai

LIUZHU 发表于 2017-6-15 12:23
什么原理？

代码都有了，自己看呗！