发现1次EVALUATE()无法代替宏的,DBF转EXCEL
******************************************************************** 经过吹斑竹的指导，改善后的代码在 19楼
** 在次优化后23楼,速度有点提高
******************************************************************
发现1次EVALUATE()无法代替宏的,见红字部分,不知道是不是我们的字符不对
** 建立测试数据
CREATE CURSOR 测试表(入库单号 C(7),入库日期 D,物料名称 C(20),数量 I,单价 N(6,2),单位 C(8),规格 C(40),付款 L,日期时间 T)
FOR i=1 To 100
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 = 50 && 每页记录
lnPageRows = 2 && 行标题行位置
lnPageCols = 2 && 第1列的位置
lnFormat = 1 && 是否根据字段设置格式
SET MARK TO "-"
LOCAL lnPageCount,oExcel,lnWorkCount,lnPage,lnSheet,lnRows,lnFieldCount,lnStartRows,lnEndRows,lnStartCols,lnEndCols,lcStartCols,lcEndCols,lcRange
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
** 当前位置开始,复制一页的记录作为文本复制到剪贴板上,3使用制表符分隔字段
GO lnRows
_vfp.DataToClip(ALIAS(),lnPageMaxSize,3)
** 计算开始和结束的列标,如 A列,AB列,最后组合出区间,如 Range("A1:H50").Select 的格式.
lcStartCols = IIF(INT(lnStartCols/26)*MOD(lnStartCols,26)>0,CHR(64+INT(lnStartCols/26)),IIF(INT(lnStartCols/26)>1,CHR(64+INT(lnStartCols/26)-1),"")) + ;
IIF(MOD(lnStartCols,26)=0,CHR(64+26),CHR(64+MOD(lnStartCols,26)))
lcEndCols = IIF(INT(lnEndCols/26)*MOD(lnEndCols,26)>0,CHR(64+INT(lnEndCols/26)),IIF(INT(lnEndCols/26)>1,CHR(64+INT(lnEndCols/26)-1),"")) + ;
IIF(MOD(lnEndCols,26)=0,CHR(64+26),CHR(64+MOD(lnEndCols,26)))
lcRange = [oExcel.Range("] + lcStartCols + TRANSFORM(lnStartRows) + [:] + lcEndCols + TRANSFORM(lnEndRows) + [").Select]
** 在VFP中,我测试这样的格式 oExcel.Range( Cells(1,1), Cells(51, 6)).Select 时报错吴,说找不到 Cells.prg,但在EXCEL的VBA中是可以运行的,如果可以就不需要上面的计算列标.
** 为了找出计算列标的方法,花了我2小时的时间,先在EXCEL表中列出对应的值,然后用EXCEL公式逐行计算,得到上面的计算方法.
** lcRange = [oExcel.Range(Cells(] + TRANSFORM(lnStartRows) + [,] + TRANSFORM(lnStartCols) +[),Cells(] + TRANSFORM(lnEndRows) + [,] + TRANSFORM(lnEndCols) +[)).Select]
&lcRange && 选择区域,也可以用 EVALUATE(lcRange)
oExcel.ActiveSheet.Paste && 粘贴数据
oExcel.Columns.AutoFit
** 设置格式
IF lnFormat>0 && 等于0时,不进行格式设置
LOCAL lcCols,lnCols,lcSelect,lcFormat,lcFormatNumber
FOR i=1 TO lnFieldCount
lnCols = lnPageCols + i - 1
lcCols = IIF(INT(lnCols/26)*MOD(lnCols,26)>0,CHR(64+INT(lnCols/26)),IIF(INT(lnCols/26)>1,CHR(64+INT(lnCols/26)-1),"")) + ;
IIF(MOD(lnCols,26)=0,CHR(64+26),CHR(64+MOD(lnCols,26)))
lcSelect = [oExcel.Range("] + lcCols + TRANSFORM(lnPageRows+1) + [:] + lcCols + TRANSFORM(lnPageMaxSize+lnPageRows) + [").Select]
&lcSelect && 选择设置格式区域,也可以用 EVALUATE(lcSelect)
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 &&设置EXCEL格式,但在这里用这个 EVALUATE(lcFormatNumber) 不出错,设置没效果,不知道什么原因.
* EVALUATE(lcFormatNumber)
ENDFOR
ENDIF
ENDFOR
oExcel.Visible=.T.
MESSAGEBOX(TRANSFORM(SECONDS()-S1))
* oExcel.Columns.AutoFit
*!* oExcelApp.ActiveWorkbook.SaveAs(cExcelFile) && 另存为
*!* oExcel.ActiveWorkbook.Save && 自动列宽
*!* oExcel.Workbooks.Close && 关闭表
*!* oExcel.Quit && 退出Excel
*!* Release oExcel &&关闭进程
[此贴子已经被作者于2018-3-23 13:54编辑过]
