如何从数组向EXCEL添加数据？ - 编程论坛

#2

sdta2021-03-26 15:09

上传AA.DBF表
可以直接从AA.DBF向EXCEL模板传输数据

[此贴子已经被作者于2021-3-26 15:10编辑过]

#3

zhousr2021-03-26 15:17

谢谢SDTA！

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

#4

wengjl2021-03-26 15:29

以下是引用zhousr在2021-3-26 15:03:43的发言：

wengjl版说：有想法，就会有办法

我又有新想法了，只是没有办法，特来求办法！

从招生计划库zsjh.dbf中把符合条件的计划导出到表AA.dbf，然后copy to BB.xls,再对BB.xls进行字体、字号等格式设置。因为每次都要对格式进行设置，比较浪费时间。我就想，先做好一个固定格式的表头，再把BB.xls的内容复制、粘贴到表头文件，这样应该更快一点。
有关代码是：
COPY TO BB.xls
oExcel=Createobject("Excel.application")
oExcel.Workbooks.Open("BB.xls")
oExcel.ActiveSheet.UsedRange.Copy
oExcel.Workbooks.Open("表头模板.xlsx")
oExcel.activesheet.Range("A3").PasteSpecial
这样，数据是可以拷过来的，但与表头模板.xlsx的格式不一样。我想，问题可能出在最后一名粘贴，应该有个参数“匹配目标单元格格式”。请问：PasteSpecial是否有参数？有的话，“匹配目标单元格格式”的参数是什么？
这种复制、粘贴的办法还会带来一个问题，就是提示“图片太大，超过部分将被截去”，目前也还没找到合适的解决方法。

另一种想法，就是把BB.xls的内容读入数组，然后从数组向表头模板.xlsx添加数据。添加后同样要保留表头模板的原格式。请问：如何从数组添加数据并匹配目标单元格格式？
谢谢！

你的那一句（红色），将标题也复制过来了，粘贴后，有二行字段名了，所以不对。

需要找到数据区域的最右下角那个单元格的地址　如：X235　然后选定　range("A2:X235").copy

具体最右下角的坐标如何确定　，前面我有一个求助贴　https://bbs.bccn.net/thread-502968-1-1.html
你去仔细研究研究，就可以了

另外，你的模板表　的字段　要与　BB　的字段　有一一对应关系（包括顺序的一一对应）

[此贴子已经被作者于2021-3-26 15:36编辑过]

#5

wengjl2021-03-26 15:39

你的另一种想法
不需要生成BB.XLS。只要打开模板，然后将AA.DBF中的数据一个一个写入即可。最后将模板表另存为…

#6

sdta2021-03-26 16:06

程序代码：

CLOSE DATABASES
ERASE 查询结果.XLSX
USE a IN 0 ALIAS aa
_VFP.DataToClip("aa", RECCOUNT(), 3)
oExcel = CreateObject("Excel.Application")
WITH oExcel
    .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx")
    .ActiveSheet.Cells(3, 1).PasteSpecial
    .ActiveSheet.Rows[3].Delete
    .DisplayAlerts = .F.
    .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51)
    .ActiveWorkbook.Close
    .DisplayAlerts = .T.
ENDWITH
IF FILE("查询结果.XLSX")
    MESSAGEBOX("EXCEL文件生成成功")
ENDIF

#7

zhousr2021-03-26 16:54

谢谢！我测试一下，等会汇报结果！

#8

wengjl2021-03-26 16:56

还是　有想法，就会有办法　
SDTA给出很简的代码

#9

zhousr2021-03-27 10:36

向SDTA汇报一下：总的来说非常成功，基本达到了要求！还有点小问题：
１.院校代码、专业代码都是文本，复制过来后成了数值型，前面的０丢失，如0001变成了１。
２.省份、城市、学制、本专科等文本后面多了若干空格。
３.备注和参考信息二个备注型字段的内容没复制过来。

再次请求办法

（表中多出一列，是我没来得及删掉）

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

[此贴子已经被作者于2021-3-27 10:41编辑过]

#10

zhousr2021-03-27 11:35

我现在把BZ和CKXX两个字段内容读入数组，然后用个循环，把备注内容写入到EXCEL。虽然能达到目的，但又循环一次，效率肯定打折扣。如果备注内容能和其他内容一起直接复制就好了。

#11

zhousr2021-03-27 16:39

以下是引用wengjl在2021-3-26 15:39:18的发言：

你的另一种想法
不需要生成BB.XLS。只要打开模板，然后将AA.DBF中的数据一个一个写入即可。最后将模板表另存为…

试了一下，从数组中一个个读入，可以读取备注内容，但速度慢很多。字符串后面的空格还是存在。能不能不一条条，而是批量读取？

[此贴子已经被作者于2021-3-27 16:48编辑过]

#12

zhousr2021-03-28 00:24

从数组读取的方案放弃了，还是采用sdta的代码。０丢失的问题，通过在模板中相应列设为文本，解决了。
现在最大的问题是字符串后面的空格如何解决？初步想法是将_cliptext的内容导出到文本，然后替换空格，再重新放回剪贴板，然后粘贴。但代码没搞定

再次求助！

#13

zhousr2021-03-28 10:58

空格替换解决了。文本格式现在是在模板中设定的，不知为何在程序中设定不起作用？
WITH oExcel
    .WorkBooks.Open("&lj\表头模板.xlsx")
    .ActiveSheet.column(1).NumberFormatLocal="0000"  &&这句没起作用
    .ActiveSheet.Cells(3,1).PasteSpecial
    .ActiveSheet.cells.replace(" ","")
endwith

#14

sdta2021-03-28 11:19

首先在模板中设置自动列宽、行高

程序代码：

CLOSE DATABASES ALL
SELECT * FROM a INTO CURSOR cx READWRITE
* 修改字符型字段的宽度
FOR lnj = 1 TO FCOUNT()
    lc1 = FIELD(lnj)
    IF TYPE(lc1) == "C"
        CALCULATE MAX(LEN(ALLTRIM(&lc1))) TO ARRAY arr
        ALTER table cx alter &lc1 c(arr[1])
    ENDIF
ENDFOR

ERASE 查询结果.XLSX
_VFP.DataToClip("cx", RECCOUNT(), 3)
oExcel = CreateObject("Excel.Application")
WITH oExcel
    .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx")
    .ActiveSheet.Cells(3, 1).PasteSpecial
    .ActiveSheet.Rows[3].Delete
    SELECT cx
    SCAN
        .ActiveSheet.Cells(2 + RECNO(), FCOUNT() - 1). Value = bz
        .ActiveSheet.Cells(2 + RECNO(), FCOUNT()). Value = ckxx
    ENDSCAN
    .DisplayAlerts = .F.
    .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51)
    .ActiveWorkbook.Close
    .DisplayAlerts = .T.
ENDWITH
IF FILE("查询结果.XLSX")
    MESSAGEBOX("EXCEL文件生成成功")
ENDIF

#15

zhousr2021-03-28 12:01

谢谢sdta，你终于出现了

测试结果汇报如下：
从18000多条记录中，筛选出符合条件的6750多条记录，然后对ECCEL表进行整理，到最后完成，总耗时１分10秒，其中执行上述
oExcel = CreateObject("Excel.Application")
......
ENDWITH
之间的代码，耗时１分０７秒。
可见，对DBF表本身进行操作是很快的，但VFP控制EXCEL操作非常耗时。
执行_VFP.DataToClip("cx", RECCOUNT(), 3)的时候，如果能把备注内容一起剪切，那速度将有极大提升。
我相信，您肯定能想出解决办法并教我

谢谢谢谢！！！

#16

sdta2021-03-28 12:06

发上数据测试下

#17

zhousr2021-03-28 12:32

好的

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

[此贴子已经被作者于2021-3-28 12:38编辑过]

#18

sdta2021-03-28 12:58

回复 17楼 zhousr

将就用吧

程序代码：

CLOSE DATABASES ALL
t1 = SECONDS()
SELECT * FROM a INTO CURSOR cx READWRITE
* 修改字符型字段的宽度
FOR lnj = 1 TO FCOUNT()
    lc1 = FIELD(lnj)
    IF TYPE(lc1) == "C"
        CALCULATE MAX(LEN(ALLTRIM(&lc1))) TO ARRAY arr
        ALTER table cx alter &lc1 c(arr[1])
    ENDIF
ENDFOR
* 把BZ、CKXX 备注字段的内容保存在字符串中
lc1 = ""
SCAN
    lc1 = lc1 + ALLTRIM(bz) + CHR(9) + ALLTRIM(ckxx) + CHR(13) + CHR(10)
ENDSCAN
ERASE 查询结果.XLSX
GO TOP
_VFP.DataToClip("cx", RECCOUNT(), 3)
oExcel = CreateObject("Excel.Application")
WITH oExcel
    .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx")
    .ActiveSheet.Cells(3, 1).PasteSpecial
    _CLIPTEXT = lc1
    .ActiveSheet.Cells(4, FCOUNT() - 1).PasteSpecial
    _CLIPTEXT = ""
    .ActiveSheet.Rows[3].Delete
    .DisplayAlerts = .F.
    .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51)
    .ActiveWorkbook.Close
    .DisplayAlerts = .T.
ENDWITH
MESSAGEBOX(SECONDS() - t1)
IF FILE("查询结果.XLSX")
    MESSAGEBOX("EXCEL文件生成成功")
ENDIF

#19

zhousr2021-03-28 13:27

sdta，哪是将就着用啊！同样的数据量，现在耗时不到８秒！！！

不仅专业，而且热心，感谢感谢！！！

#20

sdta2021-03-28 13:50

试试下面的代码

程序代码：

CLOSE DATABASES
ERASE cx.txt
ERASE 查询结果.XLSX
t1 = SECONDS()
USE a IN 0
* 生成字段列表
lcStr = ""
FOR lnj = 1 TO FCOUNT() - 2
    lcStr = lcStr + "," + FIELD(lnj)
ENDFOR
lcStr = SUBSTR(lcStr, 2)
USE IN a
SELECT * FROM a INTO CURSOR cx READWRITE
* 修改字符型字段的宽度
FOR lnj = 1 TO FCOUNT()
    lc1 = FIELD(lnj)
    IF TYPE(lc1) == "C"
        CALCULATE MAX(LEN(ALLTRIM(&lc1))) TO ARRAY arr
        ALTER table cx alter &lc1 c(arr[1])
    ENDIF
ENDFOR
COPY TO cx.txt FIELDS &lcStr DELIMITED WITH "" WITH CHARACTER TAB ALL
* 把BZ、CKXX 备注字段的内容保存在字符串中
lc1 = ""
SCAN
    lc1 = lc1 + ALLTRIM(bz) + CHR(9) + ALLTRIM(ckxx) + CHR(13) + CHR(10)
ENDSCAN

oExcel = CreateObject("Excel.Application")
WITH oExcel
    .WorkBooks.Open(SYS(5) + SYS(2003) + "\表头模板.xlsx")
    _CLIPTEXT = FILETOSTR("cx.txt")
    .ActiveSheet.Cells(3, 1).PasteSpecial
    _CLIPTEXT = lc1
    .ActiveSheet.Cells(3, FCOUNT() - 1).PasteSpecial
    _CLIPTEXT = ""
    .DisplayAlerts = .F.
    .ActiveWorkbook.Saveas(SYS(5) + SYS(2003) + "\查询结果.XLSX", 51)
    .ActiveWorkbook.Close
    .DisplayAlerts = .T.
ENDWITH
MESSAGEBOX(SECONDS() - t1)
IF FILE("查询结果.XLSX")
    MESSAGEBOX("EXCEL文件生成成功")
ENDIF

#21

sdta2021-03-28 13:52

不知道楼主最后生成的查询结果.XLSX 做什么用，自动调整行高、列宽，很消耗时间的

#22

zhousr2021-03-28 14:17

大神！！！

同样的数据，原来是５秒，现在的代码不到３秒！！！

#23

zhousr2021-03-28 14:26

以下是引用sdta在2021-3-28 13:52:41的发言：

不知道楼主最后生成的查询结果.XLSX 做什么用，自动调整行高、列宽，很消耗时间的

我现在没在程序里自动调整行高、列宽，直接在模板里设好了，可以节约时间。最后生成的查询结果.xlsx是给考生的一个志愿筛选表，这样考生就很容易选定80个志愿了。

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

#24

sdta2021-03-28 14:37

回复 23楼 zhousr

你的CPU处理器是 X.XX GHZ

#25

zhousr2021-03-28 15:00

以下是引用sdta在2021-3-28 14:37:16的发言：

你的CPU处理器是 X.XX GHZ

哈哈。。。。1.99GHZ

#26

zhousr2021-03-28 15:07

WITH oExcel.ActiveSheet
    .rows(Z+1).Font.Name="黑体"
    .rows(z+1).font.color=RGB(255,0,0)
    .column(1).NumberFormatLocal="0000"  &&这句不起作用，可能是什么原因？
ENDWITH

再请教一下

#27

sdta2021-03-28 15:20

column(1) 改为 columnS(1)

oExcel = CreateObject("Excel.Application")
oExcel.WorkBooks.Add(-4167)
oExcel.visible = .t.
oExcel.ActiveSheet.cells(1, 8).value = 12
oExcel.ActiveSheet.Columns(8).NumberFormatLocal = "0000"

[此贴子已经被作者于2021-3-28 15:35编辑过]

#28

zhousr2021-03-28 15:44

只能怪自己功底实在太浅