ExcelHome技术论坛

 找回密码
 免费注册

QQ登录

只需一步,快速开始

EH搜索     
EH云课堂-专业的职场技能充电站 Excel转在线管理系统,怎么做看这里 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! Excel 2016函数公式学习大典 高效办公必会的Office实战技巧 免费下载Excel行业应用视频
300集Office 2010微视频教程 Tableau-数据可视化工具 精品推荐-800套精选PPT模板,点击获取 ExcelHome出品 - VBA代码宝免费下载
你的Excel 2010实战技巧学习锦囊 欲罢不能, 过目难忘的 Office 新界面 Excel VBA经典代码实践指南
查看: 864|回复: 6

[求助] 利用工作表单元格排序才是王道?

[复制链接]

TA的精华主题

TA的得分主题

发表于 2017-6-14 17:22 | 显示全部楼层 |阅读模式
在网上看到了用JavaScript的sort方法进行排序,并与单元格排序对比了下,测试500000个随机数从小到大排序,感觉JavaScript被完爆啊,有没有比单元格排序更快的方法?
测试结果:
JavaScript排序:13秒
单元格排序:3秒
  1. '测试500000个数据的排序时间为13秒。

  2. Sub Java数值排序速度测试()
  3.     Dim Js As New ScriptControl
  4.     Dim Arr, kk$, Brr()
  5.     Dim i&, t1#, t2#
  6.    
  7.    
  8.     Application.ScreenUpdating = False
  9.     Application.DisplayAlerts = False
  10.    
  11.     t1 = Timer
  12.     ReDim Arr(1 To 500000)
  13.    
  14.     For i = 1 To UBound(Arr)
  15.         Arr(i) = Rnd * 10000
  16.     Next i
  17.    
  18.     kk = Join(Arr, ",")
  19.    
  20.     With Js
  21.         .Language = "JavaScript"
  22.         
  23.         .AddCode "function aa(bb){x=bb.split(',');x.sort(function(a,b){return a-b});return x;}"
  24.         
  25.         Arr = Split(.Eval("aa('" & kk & "')"), ",")
  26.     End With
  27.    
  28.     ReDim Brr(1 To UBound(Arr) + 1, 1 To 1)
  29.    
  30.     For i = 0 To UBound(Arr)
  31.         Brr(i + 1, 1) = Arr(i)
  32.     Next i
  33.    
  34.      With ActiveSheet.Range("B1").Resize(UBound(Brr), 1)
  35.         .ClearContents
  36.         .Value = Brr
  37.     End With

  38.     t2 = Timer
  39.    
  40.     Application.ScreenUpdating = True
  41.     Application.DisplayAlerts = True
  42.    
  43.     MsgBox "用时:" & Round(t2 - t1, 0) & "秒。"
  44. End Sub


  45. '测试500000个数据的排序时间为3秒。

  46. Sub 单元格排序速度测试()
  47.     Dim Arr()
  48.     Dim i&, t1#, t2#
  49.    
  50.     t1 = Timer
  51.     ReDim Arr(1 To 500000, 1 To 1)
  52.    
  53.     For i = 1 To UBound(Arr)
  54.         Arr(i, 1) = Rnd * 10000
  55.     Next i
  56.    
  57.     Application.ScreenUpdating = False
  58.     Application.DisplayAlerts = False
  59.    
  60.     With Sheets.Add(before:=Sheets(1))
  61.         With .Range("C1").Resize(UBound(Arr), 1)
  62.             .Value = Arr
  63.             .Sort key1:=ActiveSheet.Range("C1")
  64.             Arr = .Value
  65.         End With
  66.         .Delete
  67.     End With
  68.    
  69.     With Sheets("Sheet1").Range("C1").Resize(UBound(Arr), 1)
  70.         .EntireColumn.ClearContents
  71.         .Value = Arr
  72.     End With

  73.     t2 = Timer
  74.     Application.ScreenUpdating = True
  75.     Application.DisplayAlerts = True
  76.     MsgBox "用时:" & Round(t2 - t1, 0) & "秒。"
  77. End Sub
复制代码


TA的精华主题

TA的得分主题

发表于 2017-6-14 19:23 | 显示全部楼层
13 秒也能接受呀。。。。。

TA的精华主题

TA的得分主题

发表于 2017-6-14 21:35 | 显示全部楼层
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

TA的精华主题

TA的得分主题

发表于 2017-6-15 09:56 | 显示全部楼层

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-6-15 12:23 | 显示全部楼层
duquancai 发表于 2017-6-14 21:35
Sub k排序速度测试()
    Dim Arr, Brr(), i&, t1#, t2#
    t1 = Timer

什么原理?

TA的精华主题

TA的得分主题

 楼主| 发表于 2017-6-15 12:25 | 显示全部楼层
songdg 发表于 2017-6-15 09:56
试一试桶排序http://club.excelhome.net/thread-1335003-2-1.html

请告知下桶排序的原理?

TA的精华主题

TA的得分主题

发表于 2017-6-15 12:29 | 显示全部楼层
您需要登录后才可以回帖 登录 | 免费注册

本版积分规则

关闭

最新热点上一条 /1 下一条

关注官方微信,高效办公专列,每天发车

手机版|关于我们|联系我们|ExcelHome

GMT+8, 2019-8-25 09:33 , Processed in 0.085555 second(s), 13 queries , Gzip On, MemCache On.

Powered by Discuz! X3.4

© 1999-2020 Wooffice Inc.

   

沪公网安备 31011702000001号 沪ICP备11019229号

本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师

快速回复 返回顶部 返回列表