导出EXCEL表时的粘贴问题 - 编程论坛

#2

XUFN2021-08-25 10:41

我也碰到过有楼上类似的问题和疑惑，笨做法是电脑重启一次后就好了，再运行程序时没出现任何提示。怀疑跟Excel的版本有关，以前电脑里安装的是正版Excel2000,从来没出现过问题，但后来自从换了盗版的Excel2003后，同样的程序，偶尔会出现这个法粘贴失败的提示，后来尝试着优化代码，比如：
oExcel1.Cells(2,1).Select &&选择一个空白单元格自己复制自己粘贴，释放掉之前或当前的数据可能大的Copy值
oExcel1.Selection.Copy
oExcel1.ActiveSheet.Paste &&释放剪切板
后面代码再执行真正的数据复制和粘贴
但好像没用，电脑开机用过一段时间后，提示框还会出来(偶尔),电脑重新启动后就好了

#3

laowan0012021-08-25 10:49

回复 2楼 XUFN

是啊，问题挺顽固的

#4

厨师王德榜2021-08-25 11:02

如果Excel的数据格式比较规范的话,可以考虑用Ado.Connection /RecordSet 这种机制
或者ODBC连接 + sql查询语句,获取数据,避开剪贴板.

#5

吹水佬2021-08-25 11:11

剪贴板是共享的吧，如果其他应用也正在使用就可能出现异常。

#6

xuminxz2021-08-25 14:34

如果数据比较多，建议用copy to xx csv、用中间库过渡一下，例如先导入到Access、 SQL Server、 orcale中，然后导出到Excel
注意导入时如没有csv可选择文本文件（不要用 copy to xx deli 到文本文件，那样没有字段名。）

#7

laowan0012021-08-25 14:46

回复 4楼厨师王德榜

这样的话修改量太大了，而且客户端还要安装相应的环境

#8

laowan0012021-08-25 14:47

回复 5楼吹水佬

这个过程时间很短，而且测试的时候也没有其他影响剪贴板的操作

#9

laowan0012021-08-25 14:48

回复 6楼 xuminxz

copy to 有记录数限制啊

#10

xuminxz2021-08-25 14:49

回复 9楼 laowan001

复制到CSV文件没有限制。
1500000没有问题（不过excel 2016只有1000000多一点）

[此贴子已经被作者于2021-8-25 14:50编辑过]

#11

laowan0012021-08-25 15:20

回复 10楼 xuminxz

感谢回复。
CSV是记录限制要好许多，但是格式总会出现问题，比如：身份证号、条形码等都变成科学计数了，纯数字内容的字符型字段（如商品代码），也变成数值型了，日期时间字段的秒被截断了，等等
copy to test type csv 时，有什么办法可以指定列的格式吗？

[此贴子已经被作者于2021-8-25 15:22编辑过]

#12

xuminxz2021-08-25 17:43

回复 11楼 laowan001

不要直接打开。建立一个空表，“自文本文件导入”格式可以设置。

只有本站会员才能查看附件，请登录

[此贴子已经被作者于2021-8-25 18:08编辑过]

#13

laowan0012021-08-25 19:45

回复 12楼 xuminxz

感谢回复。
手工这样做没问题，我是需要用程序的方法实现

#14

sdta2021-08-25 21:44

以下是引用laowan001在2021-8-25 19:45:37的发言：

感谢回复。
手工这样做没问题，我是需要用程序的方法实现

录制宏，再用VFP控制EXCEL的方法实现

#15

laowan0012021-08-26 08:33

回复 14楼 sdta

如何“录制宏”？请指教

#16

sdta2021-08-26 13:19

以下是引用laowan001在2021-8-26 08:33:01的发言：

如何“录制宏”？请指教

百度

#17

laowan0012021-08-26 15:30

回复 16楼 sdta

感谢提示。
是我没关注过这个，在VFP帮助里发现了这个

你可以在 Visual FoxPro 中通过宏对话框来录制按键宏。
若要录制宏：
从工具菜单，选择宏。
在宏对话框中，选择录制。
按下该键或输入需要定义的组合键。
输入宏名称或接受其默认值，然后选中确定。

可我需要的是用程序的方法实现，这个是通过菜单手工执行的，还是没解决问题。

还是感谢了

#18

sdta2021-08-28 03:57

回复 17楼 laowan001

上传相关数据看看

#19

吹水佬2021-09-07 16:53

回复楼主 laowan001

以前有讨论过使用_VFP.DataToClip的贴：https://bbs.bccn.net/viewthread.php?tid=485489&extra=&highlight=EVALUATE&page=3
觉得也可以试试将数据放到数组，再将数组整块写入EXCEL

程序代码：

CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
    单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 10
    INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
         '物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
         IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR
SELECT * FROM 测试表 INTO ARRAY arr

sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO cCode TEXTMERGE NOSHOW PRETEXT 7
    FUNCTION fun(vfpArray)
        dim oExcel,oRange
        set oExcel = CREATEOBJECT("Excel.Application")
        oExcel.Workbooks.Add
        set oRange = oExcel.ActiveSheet.Range(oExcel.Cells(1,1),oExcel.Cells(UBound(vfpArray,1),UBound(vfpArray,2)))
        oRange.Value = vfpArray
        oRange.Columns.AutoFit
        oExcel.Visible = 1
    END FUNCTION
ENDTEXT
sc.AddCode(cCode)
sc.Run("fun",@arr)

#20

xcy5241002021-09-07 23:52

回复楼主 laowan001

如果打开的excel进程多了有时候会出错，因为你用.close方法在VFP里关闭工作簿，但在系统进程中还会一直有excel进程，一个文件一个进程，会出现超多进程，占用大量内存，如果工作簿处理完后建意用dos命令kill 杀死进程。用！（dos命令）[参数]

#21

schtg2021-09-08 05:29

回复 19楼吹水佬

谢谢！

#22

laowan0012021-09-08 08:26

回复 20楼 xcy524100

感谢提示
在测试的时候是没有EXCEL表格被打开，有时甚至是重新启动计算机后做的测试
另外，出现问题都是在粘贴的时候，感觉这个粘贴功能很脆弱，一会行一会不行的

#23

laowan0012021-09-08 08:34

回复 19楼吹水佬

感谢版主回复
数组的方法还真没用过，我试试

#24

laowan0012021-09-17 14:10

回复 19楼吹水佬

回吹版
数组的方法试了下，还是存在下面的问题：
1.纯数字内容的字符型字段（如身份证号），导出后成了数字型
2.时间内容导出后只保留到了 yyyy-mm-dd hh:mm，后面的秒被截断了

#25

吹水佬2021-09-17 15:15

以下是引用laowan001在2021-9-17 14:10:41的发言：

回吹版
数组的方法试了下，还是存在下面的问题：
1.纯数字内容的字符型字段（如身份证号），导出后成了数字型
2.时间内容导出后只保留到了 yyyy-mm-dd hh:mm，后面的秒被截断了

以下是引用吹水佬在2021-9-7 16:53:54的发言：

以前有讨论过使用_VFP.DataToClip的贴：https://bbs.bccn.net/viewthread.php?tid=485489&extra=&highlight=EVALUATE&page=3

19楼提到以前的贴也有提到数据格式问题
试试加个格式设置

程序代码：

CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
    单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 10
    INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
         '物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
         IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR
AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,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
SELECT * FROM 测试表 INTO ARRAY arr
sc = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
    FUNCTION fun(vfpArray, aFieldInfo)
        dim oExcel,oRange, nRows, nCols, nCol
        set oExcel = CREATEOBJECT("Excel.Application")
        oExcel.Workbooks.Add
        nRows = UBound(vfpArray,1)
        nCols = UBound(vfpArray,2)
        for nCol=1 to nCols
            oExcel.Range(oExcel.Cells(1,nCol),oExcel.Cells(nRows,nCol)).Select
            oExcel.Selection.NumberFormatLocal = aFieldInfo(nCol,8)
        next
        set oRange = oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols))
        oRange.Value = vfpArray
        oRange.Columns.AutoFit
        oExcel.Visible = 1
    END FUNCTION
ENDTEXT
sc.AddCode(vbsCode)
sc.Run("fun", @arr, @aFieldInfo)

#26

laowan0012021-09-17 19:41

回复 25楼吹水佬

回吹版
加上格式设置确实可以导出了，解决了之前的问题
我导出的表字段有39个，导出到3W条时报内存不足错误，执行中断。
估计按安全的条数分别导出后再合并到一个表里应该可以解决大记录数导出的问题

#27

laowan0012021-09-17 19:44

之前大数据量（2W以上）导出EXCEL时都是在使用oExcel.paste时出错，但又无法再现错误，相同的数据内容，大概一半多的时候是可以正常导出，其他就不敢保了
另外，使用剪贴板进行粘贴，当数据量大到一定程度时，效率会出现几何级降低

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

#28

吹水佬2021-09-17 21:32

回复 26楼 laowan001

可能数据量超出数组的限制，可以试试分块追加：

程序代码：

CREATE CURSOR 测试表 (编号 C(10), 入库单号 C(7), 入库日期 D, 物料名称 C(20), 数量 I,;
    单价 N(14,2), 单位 C(8), 规格 C(30), 付款 L, 日期时间 T, 备注 M)
FOR i=1 To 100
    INSERT INTO 测试表 VALUES (PADL(i,10,"0"), 'C'+PADL(i,6,'0'), {^2018-03-01}+INT(RAND()*10),;
         '物料'+PADL(i,3,'0'), INT(RAND()*1000), RAND()*10, '个', '"测试双引号AB"CD"',;
         IIF(i%2=0,.t.,.f.), DATETIME(), '"备注_"'+TRANSFORM(i)+'"'+0h0D0A+'_'+TRANSFORM(i)+'"'+0h0D0A)
ENDFOR

AFIELDS(aFieldInfo)
FOR i=1 TO ALEN(aFieldInfo,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 = CREATEOBJECT("ScriptControl")
sc.Language = "VBScript"
TEXT TO vbsCode TEXTMERGE NOSHOW PRETEXT 7
    dim oExcel,oRange, nRows, nCols, nCol
    set oExcel = CREATEOBJECT("Excel.Application")
    oExcel.Workbooks.Add

    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 Show(nRows, nCols)
        oExcel.Range(oExcel.Cells(1,1),oExcel.Cells(nRows,nCols)).Columns.AutoFit
        oExcel.Visible = 1
    end function
ENDTEXT
sc.AddCode(vbsCode)
sc.Run("SetFormat", @aFieldInfo, RECCOUNT("测试表"))
nStep = 10
FOR i=1 TO RECCOUNT("测试表") STEP nStep
    SELECT * FROM 测试表 WHERE BETWEEN(RECNO(),i,i+nStep-1) INTO ARRAY arr
    sc.Run("Append", @arr, i)
ENDFOR
sc.Run("Show",RECCOUNT("测试表"),FCOUNT("测试表"))

#29

laowan0012021-09-17 22:14

谢吹版！！！！！！
上面的程序可完美解决问题
经测试，每批次20000条时用时较少，10W条记录（39个字段），导出用时13秒
相同数据量，每批次10000条时，用时20秒

#30

laowan0012021-09-19 19:29

吹版好，根据您上面提供的程序，做了个导出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

#31

schtg2021-09-19 19:46

学习啦，谢谢！