** I5 3470 CPU,WIN7 64系统,8G内存
** 设置格式时,20W条记录,用时 17秒,不设置格式时,用时16秒
CREATE CURSOR 测试表(入库单号 C(7),入库日期 D,物料名称 C(20),数量 I,单价 N(6,2),单位 C(8),规格 C(40),付款 L,日期时间 T)
FOR i=1 To 200001
INSERT INTO 测试表(入库单号,入库日期,物料名称,数量,单价,单位,规格,付款,日期时间) VALUES ('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())
ENDFOR
GO RECCOUNT() - 1
REPLACE 入库日期 WITH {},单价 WITH 9.01 && 修改倒数2记录的日期为空,单价为小数
s1=SECONDS()
SELECT 测试表
GO 1
** 下面4个参数,可以作为函数参数,在VFP9.0测试通过,10W调记录大概20秒
lnReccRows = RECCOUNT()
&& 总记录数
lnPageSize = 20000
&& 每页记录
lnPageRows = 2
&& 行标题行位置
lnPageCols = 2
&& 第1列的位置
lnFormat = 0
&& 是否根据字段设置格式
SET MARK TO "-"
PRIVATE oExcel,lnPageCount,lnWorkCount,lnPage,lnSheet,lnRows,lnFieldCount,lnStartRows,lnEndRows,lnStartCols,lnEndCols
PRIVATE lnCols,lcSelect,lcRange,lcFormat,lcFormatNumber &&设置格式变量
lnFieldCount = AFIELDS(AryField)
&& 字段数量和字段内容
lnPageCount = CEILING(lnReccRows/lnPageSize) && 计算需要总页数
lnStartRows = lnPageRows
&& 初始化单元格"开始行数"
lnStartCols = lnPageCols
&& 初始化单元格"开始列数"
lnEndRows = lnPageSize + lnPageRows
&& 初始化单元格"结束行数"
lnEndCols = lnFieldCount + lnPageCols
&& 初始化单元格"结束列数"
oExcel=Createobject('excel.application') && 创建电子表格
oExcel.DisplayAlerts = .F.
&& 关闭 Excle 提示对话框
oExcel.Visible=.f.
&& 使电子表格可见 .t.
oExcel.WorkBooks.Add
&& 创建工作簿
oExcel.ActiveWindow.WindowState = 2
&& 最大化工作部
oExcel.Caption='数据导出'
&& Excel标题
** -----------------------------------------------------------------------------------------------------------
** 工作表不够,增加工作表
lnWorkCount = oExcel.Worksheets.Count
IF lnPageCount > lnWorkCount
FOR lnPage = lnWorkCount + 1 To lnPageCount Step 1
oExcel.Sheets.Add
ENDFOR
ENDIF
** -----------------------------------------------------------------------------------------------------------
** 设置工作表名称
For lnPage = 1 To lnPageCount STEP 1
oExcel.sheets(lnPage).Name = '第' + ALLTRIM(STR(lnPage)) + '页'
Endfor
** -----------------------------------------------------------------------------------------------------------
** 利用剪贴板把DBF内容复制到EXCEL表
FOR lnSheet = 1 TO lnPageCount STEP 1 && 分别打开各个工作表
oExcel.sheets(lnSheet).Activate
lnRows = (lnSheet-1) * lnPageSize + 1 && 当前页数的第1个记录号
lnPageMaxSize = IIF(lnPageSize * lnSheet > lnReccRows ,lnReccRows + lnPageSize - lnPageSize * lnSheet,lnPageSize) && 计算最后不满1页的记录数
lnEndRows = lnPageMaxSize + lnPageRows
** -----------------------------------------------------------------------------------------------------------
** 设置格式
IF lnFormat>0 && 等于0时,不进行格式设置
FOR i=1 TO lnFieldCount
lnCols = lnPageCols + i - 1
** 设置格式,如运行 oExcel.Range(oExcel.Cells( 2,2) ,oExcel.Cells(52,2)).Select
lcSelect = [oExcel.Range(oExcel.Cells(] + TRANSFORM(lnPageRows+1) + [,] + TRANSFORM(lnCols) +[),oExcel.Cells(] + TRANSFORM(lnEndRows) + [,] + TRANSFORM(lnCols) +[)).Select]
*
&lcSelect
&& 宏执行类似 oExcel.Range(oExcel.Cells( 2,2) ,oExcel.Cells(52,2)).Select
EXECSCRIPT(lcSelect) && 执行类似 oExcel.Range(oExcel.Cells( 2,2) ,oExcel.Cells(52,2)).Select
DO CASE
CASE INLIST(AryField(i,2),"C","V")
&& 文本格式
lcFormat = "@"
CASE AryField(i,2)="I"
&& 整数格式
lcFormat = "0_ "
CASE INLIST(AryField(i,2),"B","N","F") && 小数格式
lcFormat = IIF(AryField(i,4) = 0,"0_ ","0."+REPLICATE("0",AryField(i,4))+"_ ")
CASE AryField(i,2)="D"
&& 日期格式
lcFormat = "yyyy-m-d"
CASE AryField(i,2)="T"
&& 日期时间格式
lcFormat = "yyyy-m-d hh:mm:ss"
OTHERWISE
&& 其他通用格式
lcFormat = "G/通用格式"
ENDCASE
lcFormatNumber = [oExcel.Selection.NumberFormatLocal = ] + ["] + lcFormat + ["]
*
&lcFormatNumber
&& 宏执行类似 oExcel.Selection.NumberFormatLocal = "@"
EXECSCRIPT(lcFormatNumber)
&& 执行类似 oExcel.Selection.NumberFormatLocal = "@"
ENDFOR
ENDIF
** -----------------------------------------------------------------------------------------------------------
** 从当前位置开始,复制一页的记录作为文本复制到剪贴板上,3使用制表符分隔字段
GO lnRows
_vfp.DataToClip(ALIAS(),lnPageMaxSize,3)
** 选择区域,如 oExcel.Range(oExcel.Cells( 2,2) ,oExcel.Cells(52,10)).Select
lcRange = [oExcel.Range(oExcel.Cells(] + TRANSFORM(lnStartRows) + [,] + TRANSFORM(lnStartCols) +[),oExcel.Cells(] + TRANSFORM(lnEndRows) + [,] + TRANSFORM(lnEndCols) +[)).Select]
*
&lcRange
&& 宏执行类似 oExcel.Range(oExcel.Cells( 2,2) ,oExcel.Cells(52,10)).Select
EXECSCRIPT(lcRange)
&& 执行类似 oExcel.Range(oExcel.Cells( 2,2) ,oExcel.Cells(52,10)).Select
oExcel.ActiveSheet.Paste && 粘贴数据
oExcel.Columns.AutoFit
ENDFOR
MESSAGEBOX(TRANSFORM(SECONDS()-S1))
oExcel.Visible=.T.
*!* oExcelApp.ActiveWorkbook.SaveAs(cExcelFile)
&& 另存为
*!* oExcel.ActiveWorkbook.Save
&& 自动列宽
*!* oExcel.Workbooks.Close
&& 关闭表
*!* oExcel.Quit
&& 退出Excel
*!* Release oExcel
&&关闭进程