• Excel的Range直接绑定数组,实现数据快速填充


    这是一篇老文了,整理下发出来,希望能对大家有些帮助

    一般我们在程序中操作Excel时,逐单元格填充时,速度非常之慢。

    其实Excel的Range可以直接绑定数组,速度极快。在下面的 VB6 示例中,填充一个1000*10的区块,

    逐单元格方式要20~25秒,而数组方式瞬间内即可完成。

    Private Sub Command2_Click()
        Dim a(1000, 10) As Integer
        Dim i As Integer
        Dim j As Integer
        Dim z As Integer
        Dim oXLSAPP As New Excel.Application
        Dim oWSheet As Worksheet
        
        Command2.Enabled = False
    
        '创建一个新的Excel文件
        oXLSAPP.Workbooks.Add
        oXLSAPP.Workbooks(1).Activate
       
        Set oWSheet = oXLSAPP.Workbooks(1).Worksheets(1)
        oWSheet.Activate
        
        '准备一个数组
            For i = 1 To 1000
                For j = 1 To 10
                    Randomize
                    a(i, j) = CInt(1000 * Rnd)
                    Randomize
                    z = z + 1
                    DoEvents
                Next
            Next
            
        '利用这个数组填充
        Dim xrange As Range
        Set xrange = oWSheet.Range("A1:J1000")
        Label9.Caption = "正在进行逐格填充"
        DoEvents
        
       
        Label2(0).Caption = Now()
         For i = 1 To 1000
            For j = 1 To 10
                xrange(i, j).Value = a(i, j)
                'DoEvents
            Next
            'DoEvents
        Next
        Label3(0).Caption = Now()
        Label9.Caption = "逐格填充完毕"
        Label5(0).Caption = DateDiff("s", CDate(Label2(0).Caption), CDate(Label3(0).Caption)) & ""
        DoEvents
        '-------------------------------------------------------------
        '直接填充
        Label9.Caption = "正在进行数组填充"
        DoEvents
        Label2(1).Caption = Now()
        '##################################
        '直接把数据给区块
        '需要注意的是,这个区块接受数组是从序号0开始的.用的时候注意边界
        oWSheet.Range("L1:U1000") = a
        '##################################
        Label3(1).Caption = Now()
        Label9.Caption = "数组填充完毕"
        Label5(1).Caption = DateDiff("s", CDate(Label2(1).Caption), CDate(Label3(1).Caption)) & ""
        DoEvents
        Dim fname As String
        fname = App.Path & "" & Format(Now, "yyyymmddhhMMss") & ".xls"
        oXLSAPP.Workbooks(1).SaveAs fname
        Label9.Caption = "文件保存到 " & fname
        DoEvents
        
        Set oXLSAPP = Nothing
       
    End Sub

     另外特别推荐:
    特别推荐:纯VB.NET代码直接生成Excel文件(不需要Excel) 

  • 相关阅读:
    ATM+购物车项目
    python基础语法13 内置模块 subprocess, 正则表达式re模块, logging日志记录模块, 防止导入模块时自动执行测试功能, 包的理论
    kvm ip查看
    tar 排除某个目录
    MySQL5.7 添加用户、删除用户与授权
    tomcat 自带jdk
    django examples 学习笔记(1)创建一个独立的python环境
    cdh 安装组件 异常总结
    pycharm ubuntu安装
    (cdh)hive 基础知识 名词详解及架构
  • 原文地址:https://www.cnblogs.com/Spacecup/p/3643029.html
Copyright © 2020-2023  润新知