以下是引用mywisdom88在2018-3-24 10:50:34的发言：
好，刚测试一下，10W记录, I5 3470,8G,WIN7 64,
在有备注字段时，每页1W记录，花45秒
在没备注字段时，每页1W记录，花15秒
能否在有备注字段的时候，优化。。。
写了个类似 VFP.DataToClip() 的_MemToClipCol函数来处理，速度好象较快。
复制数据格式：
列块复制：
每个单元的内容用双引号表示（"单元"），不同单元用回车换行符（0h0D0A）分隔。
备注字段内容包含的双引号“"”要替换成“""”
**
** DBF转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 101
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), INT(RAND()*100)*1.00, '个', '',;
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,7] = 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
t1=SECONDS()
_DBF_EXCEL("C:\TEMP\test.xls", "测试表", @aFieldInfo, 20, 4, 1, "数 据 导 出 表", 2)
? SECONDS()-t1
RETURN
**
** DBF转EXCEL
** _DBF_EXCEL(cOutFile, cAlias, aFieldInfo, nPageRows, nStartRow, nStartCol, cTitle, nTitleRow)
**
cOutFile
输出EXCEL文件名
**
cAlias
DBF表工作区别名
**
aFieldInfo
字段信息，用AFIELDS()获取，可自定义栏目名、数据格式等。
**
nPageRows
每页数据行数
**
nStartRow
开始行
**
nStartCol
开始列
**
cTitle
标题
**
nTitleRow
标题行
**
FUNCTION _DBF_EXCEL(cOutFile, cAlias, aFieldInfo, nPageRows, nStartRow, nStartCol, cTitle, nTitleRow)
LOCAL oExcel
oExcel = CREATEOBJECT("Excel.Application")
&& 创建电子表格
oExcel.DisplayAlerts = .F.
&& 关闭 Excle 提示对话框
oExcel.WorkBooks.Add
&& 创建工作簿
* 如果页数多了，删除多余的
LOCAL nPageCount
nPageCount = CEILING(RECCOUNT(cAlias)/nPageRows)
&& 页数
DO WHILE oExcel.Worksheets.Count > nPageCount
oExcel.Sheets[oExcel.Worksheets.Count].Select
oExcel.ActiveWindow.SelectedSheets.Delete
ENDDO
* 如果页数不够，添加
FOR i=oExcel.Worksheets.Count+1 TO nPageCount
oExcel.Sheets.Add
ENDFOR
* 页名
FOR i=1 TO nPageCount
oExcel.Sheets[i].Name = "第"+TRANSFORM(i)+"页"
ENDFOR
* 利用剪贴板把DBF内容复制到EXCEL表
SELECT (cAlias)
LOCAL nRow, nCol, nEndRow, nEndCol
nEndRow = nStartRow + nPageRows
&& 结束行，第1行为栏目行
nEndCol = nStartCol + ALEN(aFieldInfo,1) - 1
&& 结束列
FOR i=1 TO nPageCount
&& 处理各页
WITH oExcel
* 打开页
.Sheets[i].Activate
* 标题格式设置
.Range(.Cells(nTitleRow,nStartCol), .Cells(nTitleRow,nEndCol)).Select
.Selection.NumberFormatLocal = "@"
&& 文本格式
.Selection.HorizontalAlignment = -4108
&& 居中 xlCenter
.Selection.VerticalAlignment = -4108
.Selection.Merge
&& 合并单元格
* 栏目行格式设置
.Range(.Cells(nStartRow,nStartCol), .Cells(nStartRow,nEndCol)).Select
.Selection.NumberFormatLocal = "@"
.Selection.HorizontalAlignment = -4108
&& 居中 xlCenter
.Selection.VerticalAlignment = -4108
* 各列数据格式设置
FOR nCol=nStartCol TO nEndCol
.Range(.Cells(nStartRow+1,nCol), .Cells(nEndRow,nCol)).Select
.Selection.NumberFormatLocal = aFieldInfo[nCol-nStartCol+1, 8]
ENDFOR
.Cells(nTitleRow,nStartCol).Value = cTitle
&& 标题
GO (i-1)*nPageRows + 1
&& 每页第一行的数据记录位置
_VFP.DataToClip(cAlias, nPageRows, 3)
&& 复制DBF记录
_CLIPTEXT = STRTRAN(_CLIPTEXT, '"', '＂')
.Range(.Cells(nStartRow,nStartCol), .Cells(nEndRow,nEndCol)).Select
.ActiveSheet.Paste
&& 粘贴到EXCEL
FOR nCol=nStartCol TO nEndCol
&& 用自定义栏目名
.Cells(nStartRow,nCol).Value = ALLTRIM(aFieldInfo[nCol-nStartCol+1, 7])
ENDFOR
FOR nCol=nStartCol TO nEndCol
&& 处理备注字段
IF aFieldInfo[nCol-nStartCol+1, 2]=="M"
GO (i-1)*nPageRows + 1
* 速度较快
_MemToClipCol(cAlias, aFieldInfo[nCol-nStartCol+1, 1], nPageRows)
.Range(.Cells(nStartRow+1,nCol), .Cells(nEndRow,nCol)).Select
.ActiveSheet.Paste
&& 粘贴到EXCEL
**
* 速度较慢
**
nRow = nStartRow+1
**
SCAN NEXT nPageRows
**
.Cells(nRow,nCol).Value = EVALUATE(aFieldInfo[nCol-nStartCol+1, 1])
**
nRow = nRow + 1
**
ENDSCAN
ENDIF
ENDFOR
.Cells(1,1).Select
.Columns.AutoFit
&& 自动适应行列宽
.Rows.AutoFit
ENDWITH
ENDFOR
oExcel.Sheets[1].Activate
&& 打开第1页
**
* 调试观察时用
**
oExcel.ActiveWindow.WindowState = 2
&& 最大化窗口
**
oExcel.Caption = cTitle
&& Excel标题
**
oExcel.Visible = .T.
**
MESSAGEBOX("中断预览")
* 保存关闭
oExcel.ActiveWorkbook.SaveAs(cOutFile, -4143)
&& 另存, 常规工作簿格式，xlNormal：-4143
oExcel.Workbooks.Close
&& 关闭工作簿
oExcel.Quit
&& 关闭Excel
RELEASE oExcel
&& 释放oExcel
ENDFUNC
FUNCTION _MemToClipCol(cAlias, cFieldName, nRecord)
LOCAL cMem
cMem = ""
SELECT (cAlias)
IF !EOF()
cMem = '"' + STRTRAN(EVALUATE(cFieldName), '"', '""') + '"'
SKIP
SCAN NEXT nRecord-1
cMem = cMem + 0h0D0A + '"' + STRTRAN(EVALUATE(cFieldName), '"', '""') + '"'
ENDSCAN
ENDIF
_CLIPTEXT = cMem
ENDFUNC
[此贴子已经被作者于2018-3-24 23:31编辑过]
