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

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

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

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

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

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 

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

发上数据测试下

好的

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

将就用吧

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 

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

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

试试下面的代码

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