ExcelHome技术论坛

 找回密码
 免费注册
QQ登录 只需一步,快速开始
   
高效办公必会的Office99uu优优 永久免费,网表让Excel秒变数据库 Excel服务器-会Excel,做管理系统 Excel Home精品图文教程库
Excel不给力? 何不试试FoxTable! 国内首部Excel函数公式学习大典 职场充电黑科技, Office微99uu优优 免费下载Excel行业应用视频
300集Office 2010微99uu优优 Tableau-数据可视化工具 突破Excel限制,用活字格提高效率 12门Excel免费公开课任你学
你的Excel 201099uu优优学习锦囊 欲罢不能, 过目难忘的 Office 新界面 免费的Excel考勤计算系统
查看: 72|回复: 6
打印 上一主题 下一主题

[求助] 把EXCEL工作表的数据装入数组和集合,速度很慢,有解决办法吗?

[复制链接]
TA的精华主题TA的得分主题
跳转到指定楼层
1
发表于 2018-1-12 23:31 | 只看该作者 |只看大图 回帖奖励 |倒序浏览 |阅读模式
请看附件,工作表zhuli_1min共有278414行数据。我在工作表“装入数据”写了个脚本,把工作表zhuli_1min的数据装入数组中,并输出到工作表“装入数据”中。

这只是个测试,我本来是想装入数组后进行统计分析的,但是仅仅装入数据就花了好几分钟时间,速度非常慢。

在论坛看到有些人说用集合很快一些,因为数组的redim preserve很耗时。我又改用集合,但用集合更慢,泪奔ing.

请问我的脚本是否有问题,应如何改进?

装入数组的脚本:

Private Sub CommandButton1_Click()
Range("a:i").ClearContents
Dim run_start As Date, run_end As Date, run_medium As Date
Dim loaddata_hour As Integer
Dim loaddata_minute As Integer
Dim loaddata_second As Integer
Dim runtime_hour As Integer
Dim runtime_minute As Integer
Dim runtime_second As Integer
Dim runtime_contrast As String

Dim i
Dim arrshiji1min() As jichusj
Dim colshiji1min As New Collection
Dim colone1min As jichusj1
Dim starttime As Date
Dim endtime As Date
run_start = Format(Now(), "yyyy-mm-dd HH:MM:SS")  ' 开始运算时间
i = 0
Do While Len(Sheets("zhuli_1min").Cells(i + 2, 1)) <> 0
'redim数组并赋值
    ReDim Preserve arrshiji1min(i + 1)
    arrshiji1min(i).sdate = Sheets("zhuli_1min").Cells(i + 2, 1)
    arrshiji1min(i).stime = Sheets("zhuli_1min").Cells(i + 2, 2)
    arrshiji1min(i).szhulihy = Sheets("zhuli_1min").Cells(i + 2, 3)
    arrshiji1min(i).sshijihy = Sheets("zhuli_1min").Cells(i + 2, 4)
    arrshiji1min(i).skaipan = Sheets("zhuli_1min").Cells(i + 2, 5)
    arrshiji1min(i).szuigao = Sheets("zhuli_1min").Cells(i + 2, 6)
    arrshiji1min(i).szuidi = Sheets("zhuli_1min").Cells(i + 2, 7)
    arrshiji1min(i).sshoupan = Sheets("zhuli_1min").Cells(i + 2, 8)


i = i + 1
Loop
run_medium = Format(Now(), "yyyy-mm-dd HH:MM:SS") '记录完成装载数据的时间

'假如用数组,输出数组到表中
    For i = 0 To UBound(arrshiji1min) - 1
        Cells(i + 1, 1) = arrshiji1min(i).sdate
        Cells(i + 1, 2) = arrshiji1min(i).stime
        Cells(i + 1, 3) = arrshiji1min(i).szhulihy
        Cells(i + 1, 4) = arrshiji1min(i).sshijihy
        Cells(i + 1, 5) = arrshiji1min(i).skaipan
        Cells(i + 1, 6) = arrshiji1min(i).szuigao
        Cells(i + 1, 7) = arrshiji1min(i).szuidi
        Cells(i + 1, 8) = arrshiji1min(i).sshoupan
    Next


run_end = Format(Now(), "yyyy-mm-dd HH:MM:SS") '结束运算时间,完成输出数据到工作表中
    'RunTime_Day = DateDiff("d", Run_Start, Run_End) '天数差
    loaddata_hour = DateDiff("h", run_start, run_medium) '小时差
    loaddata_minute = DateDiff("n", run_start, run_medium) Mod 60 '分钟差
    loaddata_second = DateDiff("s", run_start, run_medium) Mod 60 '秒差
    runtime_hour = DateDiff("h", run_start, run_end) '小时差
    runtime_minute = DateDiff("n", run_start, run_end) Mod 60 '分钟差
    runtime_second = DateDiff("s", run_start, run_end) Mod 60 '秒差
    runtime_contrast1 = loaddata_hour & "小时" & loaddata_minute & "分钟" & loaddata_second & "秒"
    runtime_contrast = runtime_hour & "小时" & runtime_minute & "分钟" & runtime_second & "秒"
    MsgBox "Done! 已完成运算!--共用时:" & runtime_contrast & "其中装载数据用时:" & runtime_contrast1

End Sub



装入集合的脚本:

Private Sub CommandButton1_Click()
Range("a:i").ClearContents
Dim run_start As Date, run_end As Date, run_medium As Date
Dim loaddata_hour As Integer
Dim loaddata_minute As Integer
Dim loaddata_second As Integer
Dim runtime_hour As Integer
Dim runtime_minute As Integer
Dim runtime_second As Integer
Dim runtime_contrast As String

Dim i
Dim arrshiji1min() As jichusj
Dim colshiji1min As New Collection
Dim colone1min As jichusj1
Dim starttime As Date
Dim endtime As Date
run_start = Format(Now(), "yyyy-mm-dd HH:MM:SS")  ' 开始运算时间
i = 0
Do While Len(Sheets("zhuli_1min").Cells(i + 2, 1)) <> 0

'初始化集合并赋值
    Set colone1min = New jichusj1
    colone1min.sdate = Sheets("zhuli_1min").Cells(i + 2, 1)
    colone1min.stime = Sheets("zhuli_1min").Cells(i + 2, 2)
    colone1min.szhulihy = Sheets("zhuli_1min").Cells(i + 2, 3)
    colone1min.sshijihy = Sheets("zhuli_1min").Cells(i + 2, 4)
    colone1min.skaipan = Sheets("zhuli_1min").Cells(i + 2, 5)
    colone1min.szuigao = Sheets("zhuli_1min").Cells(i + 2, 6)
    colone1min.szuidi = Sheets("zhuli_1min").Cells(i + 2, 7)
    colone1min.sshoupan = Sheets("zhuli_1min").Cells(i + 2, 8)
    colshiji1min.Add colone1min

i = i + 1
Loop
run_medium = Format(Now(), "yyyy-mm-dd HH:MM:SS") '记录完成装载数据的时间


'假如用集合,输出数集合到表中
    For i = 1 To colshiji1min.Count
        Cells(i, 1) = colshiji1min.Item(i).sdate
        Cells(i, 2) = colshiji1min.Item(i).stime
        Cells(i, 3) = colshiji1min.Item(i).szhulihy
        Cells(i, 4) = colshiji1min.Item(i).sshijihy
        Cells(i, 5) = colshiji1min.Item(i).skaipan
        Cells(i, 6) = colshiji1min.Item(i).szuigao
        Cells(i, 7) = colshiji1min.Item(i).szuidi
        Cells(i, 8) = colshiji1min.Item(i).sshoupan
    Next

run_end = Format(Now(), "yyyy-mm-dd HH:MM:SS") '结束运算时间,完成输出数据到工作表中
    'RunTime_Day = DateDiff("d", Run_Start, Run_End) '天数差
    loaddata_hour = DateDiff("h", run_start, run_medium) '小时差
    loaddata_minute = DateDiff("n", run_start, run_medium) Mod 60 '分钟差
    loaddata_second = DateDiff("s", run_start, run_medium) Mod 60 '秒差
    runtime_hour = DateDiff("h", run_start, run_end) '小时差
    runtime_minute = DateDiff("n", run_start, run_end) Mod 60 '分钟差
    runtime_second = DateDiff("s", run_start, run_end) Mod 60 '秒差
    runtime_contrast1 = loaddata_hour & "小时" & loaddata_minute & "分钟" & loaddata_second & "秒"
    runtime_contrast = runtime_hour & "小时" & runtime_minute & "分钟" & runtime_second & "秒"
    MsgBox "Done! 已完成运算!--共用时:" & runtime_contrast & "其中装载数据用时:" & runtime_contrast1
End Sub


测试的文件.part1.rar (1.8 MB, 下载次数: 7)

测试的文件.part2.rar (1.8 MB, 下载次数: 7)
测试的文件.part3.rar (1.8 MB, 下载次数: 7)
测试的文件.part4.rar (1.8 MB, 下载次数: 6)
测试的文件.part5.rar (1.69 MB, 下载次数: 7)

分享到:  QQ好友和群QQ好友和群 QQ空间QQ空间 腾讯微博腾讯微博 腾讯朋友腾讯朋友
收藏收藏 分享分享 有用有用 无用无用
TA的精华主题TA的得分主题
2
 楼主| 发表于 2018-1-13 18:16 | 只看该作者 |楼主
TA的精华主题TA的得分主题
3
发表于 2018-1-13 19:49 | 只看该作者
把数据写入数组:
  • Dim lastrow As Long
  • lastrow = Sheets("zhuli_1min").Range("A1").End(xlDown).Row
  • arrshijilmin = Sheets("zhuli_1min").Range("A2:H" & lastrow)
  • 复制代码

    把数组中的数据写入工作表
  • Range("A1").Resize(lastrow - 1, 8).Value = arrshijilmin
  • 复制代码
    TA的精华主题TA的得分主题
    4
    发表于 2018-1-13 19:52 | 只看该作者
    你的文件太多,我就不下载了。你的代码太长,我只看了一半就不看了。集合是对象,应该没有数组快的!我认为你使用数组的方式是错误的,你一个个单元格赋值给数组,等于读了几十万个单元格对象。赋值给数组直接一次性赋值才是正确的姿势,
    比如arr=sheet1.usedrange,在数组中处理好,再一次性输出到表格,比如range("a1").resize(ubound(arr),ubound(arr,2))这样
    TA的精华主题TA的得分主题
    5
    发表于 2018-1-13 20:12 | 只看该作者
    本帖最后由 ivccav 于 2018-1-13 20:15 编辑

    还是想帮一下楼主,下载了附件。

    我的电脑2007年入的,15.56秒,30万行数据,现在的电脑不会超过10秒的。

    Sub test()
    t = Timer
    arr = Sheet1.Range("a1").CurrentRegion
    Sheet2.Range("a1").Resize(UBound(arr), UBound(arr, 2)) = arr
    Debug.Print Format(Timer - t, "0.00秒")
    End Sub



    TA的精华主题TA的得分主题
    6
    发表于 2018-1-13 20:14 | 只看该作者
    本帖最后由 zorsite 于 2018-1-13 20:17 编辑
  • Option Explicit
  • Sub load_reload()
  •     Application.ScreenUpdating = False
  •     Dim arr
  •     Dim lastrow&
  •     Dim t#, t1#, t2#
  •    
  •     t = Timer
  •     lastrow = Sheets("zhuli_1min").Range("A1").End(xlDown).Row
  •     arr = Sheets("zhuli_1min").Range("A2:H" & lastrow).Value
  •     t1 = Format((Timer - t), "0.00000")
  •    
  •     t = Timer
  •     With Sheets("装入数组")
  •         .Cells.Clear
  •         .Columns("B").NumberFormatLocal = "h:mm;@"
  •         .Range("A1").Resize(lastrow - 1, 8).Value = arr
  •     End With
  •     t2 = Format((Timer - t), "0.00000")
  •    
  •     MsgBox "Done! 装载用时:" & t1 & "秒,卸载用时:" & t2 & "秒。"
  •     Application.ScreenUpdating = True
  • End Sub

  • 复制代码

    你原有的附件太大了,就不再上传了。

    TA的精华主题TA的得分主题
    7
     楼主| 发表于 2018-1-13 21:56 | 只看该作者 |楼主
    谢谢楼上两位,试运行了下,11秒就可以搞定。谢谢!

    VBA的数组成员似乎要求同一数据类型,而我的表中有字符串,有整型,有日期类型,有浮点。为什么可以这样装载呢?
    您需要登录后才可以回帖 登录 | 免费注册
    本版积分规则
    关闭

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

    关注官方微信,每天坐享新鲜教程
    手机版|关于我们|联系我们|ExcelHome    GMT+8, 2018-1-18 19:33 , Processed in 0.087755 second(s), 13 queries , Gzip On, MemCache On.
    Powered by Discuz! X3.3 © 2001-2017 Wooffice Inc.
        沪公网安备 31011702000001号 沪ICP备11019229号 本论坛言论纯属发表者个人意见,任何违反国家相关法律的言论,本站将协助国家相关部门追究发言者责任!     本站特聘法律顾问:徐怀玉律师 李志群律师
    快速回复 返回顶部 返回列表
    99uu优优