| 网站首页 | 业界新闻 | 小组 | 威客 | 人才 | 下载频道 | 博客 | 代码贴 | 在线编程 | 编程论坛
欢迎加入我们,一同切磋技术
用户名:   
 
密 码:  
共有 3683 人关注过本帖
标题:导出EXCEL表时的粘贴问题
取消只看楼主 加入收藏
laowan001
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:66
帖 子:1076
专家分:2628
注 册:2015-12-30
收藏
得分:0 
回复 19楼 吹水佬
感谢版主回复
数组的方法还真没用过,我试试
2021-09-08 08:34
laowan001
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:66
帖 子:1076
专家分:2628
注 册:2015-12-30
收藏
得分:0 
回复 19楼 吹水佬
回吹版
数组的方法试了下,还是存在下面的问题:
1.纯数字内容的字符型字段(如身份证号),导出后成了数字型
2.时间内容导出后只保留到了  yyyy-mm-dd hh:mm,后面的秒被截断了
2021-09-17 14:10
laowan001
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:66
帖 子:1076
专家分:2628
注 册:2015-12-30
收藏
得分:0 
回复 25楼 吹水佬
回吹版
加上格式设置确实可以导出了,解决了之前的问题
我导出的表字段有39个,导出到3W条时报内存不足错误,执行中断。
估计按安全的条数分别导出后再合并到一个表里应该可以解决大记录数导出的问题
2021-09-17 19:41
laowan001
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:66
帖 子:1076
专家分:2628
注 册:2015-12-30
收藏
得分:0 
之前大数据量(2W以上)导出EXCEL时都是在使用oExcel.paste时出错,但又无法再现错误,相同的数据内容,大概一半多的时候是可以正常导出,其他就不敢保了
另外,使用剪贴板进行粘贴,当数据量大到一定程度时,效率会出现几何级降低


[此贴子已经被作者于2021-9-17 19:48编辑过]

2021-09-17 19:44
laowan001
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:66
帖 子:1076
专家分:2628
注 册:2015-12-30
收藏
得分:0 
谢吹版!!!!!!
上面的程序可完美解决问题
经测试,每批次20000条时用时较少,10W条记录(39个字段),导出用时13秒
相同数据量,每批次10000条时,用时20秒
2021-09-17 22:14
laowan001
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:66
帖 子:1076
专家分:2628
注 册:2015-12-30
收藏
得分:0 
吹版好,根据您上面提供的程序,做了个导出EXCEL函数,请指正
(1)可在一个EXCEL中导出不同sheet
(2)加上了表头行
(3)测试结果:sheet1-7042条,sheet2-473765条,用时277秒

FUNCTION Dbf2excel(cExcelfilename,cDbfname,cSheetname,cFields,cFilter)
********************************************************
* cExcelfilename:C,带完整路径的EXCEL文件全名,abc.xlsx
* cDbfname: C,数据文件名
* cSheetname: C,工作表名字,可空
* cFields: C,"class 班级,name 姓名,math 数学"
* cFilter: C,数据过滤条件,可空
********************************************************
cFields = EVL(cFields,'*')
cSheetname = EVL(cSheetname,'')
cFilter = EVL(cFilter,'1=1')

LOCAL sc,arr[1],vbsCode,aFieldInfo[1],nStep,xnewfile,xtmpfile,i,xfile
xfile = cDbfname

sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
    dim oExcel,oRange, nRows, nCols, nCol,cExcelname
    set oExcel = CREATEOBJECT("Excel.Application")

    function Open(cExcelname,cSheetname,nNew)
        if nNew=0 then        ' 新建
            oExcel.Workbooks.Add
            oExcel.ActiveWorkbook.saveas cExcelname
        else                '已有
            oExcel.Workbooks.Open(cExcelname)
            oExcel.ActiveWorkbook.Worksheets.Add
        end if

        if cSheetname<>"" then
            oExcel.Activesheet.name = cSheetname
        end if
    end function
   
    function SetFormat(aFieldInfo, nRows)
        for nCol=1 to UBound(aFieldInfo,1)
            oExcel.Range(oExcel.Cells(1,nCol),oExcel.Cells(nRows,nCol)).Select
            oExcel.Selection.NumberFormatLocal = aFieldInfo(nCol,8)
        next  
    end function

    function Append(vfpArray, nRow)
        nRows = UBound(vfpArray,1)
        nCols = UBound(vfpArray,2)
        oExcel.Range(oExcel.Cells(nRow,1),oExcel.Cells(nRow+nRows-1,nCols)).Value = vfpArray
    end function

    function Close(nRows, nCols)
        oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
        oExcel.Cells(1,1).select
        oExcel.ActiveWorkbook.save
        oExcel.quit
    end function
   
    function Show(nRows, nCols)
        oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
        oExcel.Visible = 1   
    end function
ENDTEXT  
sc.AddCode(vbsCode)

* 是否新建EXCEL文件
xnewfile = IIF(file(cExcelfilename),1,0)
sc.Run("Open", cExcelfilename,cSheetname,xnewfile)

* 表头数组
xtmpfile = SYS(2015)
SELECT &cFields FROM &xfile WHERE &cFilter INTO CURSOR &xtmpfile READWRITE
DIMENSION arr[1,fcount(xtmpfile)]

* 字段类型
SELECT &xtmpfile
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,1)
    arr[1,i] = aFieldInfo[i,1]
    aFieldInfo[i,8] = ICASE(;    && 数据格式
        aFieldInfo[i,2]=="I", '##0;[=0]""',;              && 整数格式
        INLIST(aFieldInfo[i,2],"B","N","F"), '#,##0.'+REPLICATE("0",aFieldInfo[i,4])+';[=0]""',; && 小数格式
        INLIST(aFieldInfo[i,2],"C","V","W","M"), '@',;    && 文本格式
        aFieldInfo[i,2]=="D", 'yyyy-m-d',;                && 日期格式
        aFieldInfo[i,2]=="T", 'yyyy-m-d hh:mm:ss',;       && 日期时间格式
        'G/通用格式')
ENDFOR

* 插入表头
sc.Run("Append", @arr, 1)

* 各列格式
sc.Run("SetFormat", @aFieldInfo, RECCOUNT(xtmpfile)+1)

* 表体
nStep = 10000
FOR i=1 TO RECCOUNT(xtmpfile) STEP nStep
    SELECT * FROM &xtmpfile WHERE BETWEEN(RECNO(),i,i+nStep-1) INTO ARRAY arr
    sc.Run("Append", @arr, i+1)
ENDFOR

sc.Run("Close",RECCOUNT(xtmpfile),FCOUNT(xtmpfile))

*sc.Run("Show",RECCOUNT(xfile),FCOUNT(xfile))
* 如果需要当时查看EXCEL表,可执行上面的语句

RELEASE sc
RETURN
2021-09-19 19:29
快速回复:导出EXCEL表时的粘贴问题
数据加载中...
 
   



关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.012659 second(s), 9 queries.
Copyright©2004-2024, BCCN.NET, All Rights Reserved