| 网站首页 | 业界新闻 | 群组 | 交易 | 人才 | 下载频道 | 博客 | 代码贴 | 编程论坛
共有 1859 人关注过本帖
标题:发现1次EVALUATE()无法代替宏的,DBF转EXCEL
只看楼主 加入收藏
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:169
帖 子:6389
专家分:28017
注 册:2014-5-20
  得分:0 
使用_VFP.DataToClip(),字符串第一个字符是双引号("),粘贴时可能会出现异常,这个问题不好处理。
自定义一个类似的函数 _DataToClip() 来处理(同时处理栏目行和备注字段),速度也差不多。

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), RAND()*10, '个', '"测试双引号AB"CD"',;
         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(),字符串第一个字符是双引号("),粘贴时可能会出现异常
                * 自定义一个类似的函数 _DataToClip() 来处理(同时处理栏目行和备注字段)
            _DataToClip(cAlias, @aFieldInfo, nPageRows)    && 复制DBF记录
            .Range(.Cells(nStartRow,nStartCol), .Cells(nEndRow,nEndCol)).Select
            .ActiveSheet.Paste  && 粘贴到EXCEL
            .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

    * DBF复制数据到剪贴板
    * 数据格式:列分隔符为制表符,行分隔符为回车符
    *    "列1数据"制表符"列2数据"制表符 ...... 制表符"列n数据"回车符
FUNCTION _DataToClip(cAlias, aFieldInfo, nRecord)
    SELECT (cAlias)
    IF EOF()
        RETURN .F.
    ENDIF
    LOCAL i, cMem
    cMem = '"' + STRTRAN(aFieldInfo[1,7], '"', '""') + '"'
    FOR i=2 TO ALEN(aFieldInfo,1)
        cMem = cMem + 0h09 + '"' + STRTRAN(aFieldInfo[i,7], '"', '""') + '"'
    ENDFOR
    cMem = cMem + 0h0D
    SCAN NEXT nRecord
        cMem = cMem + _GetData(@aFieldInfo, 1)
        FOR i=2 TO ALEN(aFieldInfo,1)
            cMem = cMem + 0h09 + _GetData(@aFieldInfo, i)
        ENDFOR
        cMem = cMem + 0h0D
    ENDSCAN
    _CLIPTEXT = cMem
    RETURN .T.
ENDFUNC

FUNCTION _GetData(aFieldInfo, nFieldNum)
    LOCAL cMem
    cMem = ICASE(;
        aFieldInfo[nFieldNum,2]=="I", '"'+TRANSFORM(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
        INLIST(aFieldInfo[nFieldNum,2],"B","N","F"), '"'+;
            LTRIM(STR(EVALUATE(aFieldInfo[nFieldNum,1]),aFieldInfo[nFieldNum,3],aFieldInfo[nFieldNum,4]))+'"',;
        INLIST(aFieldInfo[nFieldNum,2],"C","V","W","M"), '"'+STRTRAN(EVALUATE(aFieldInfo[nFieldNum,1]),'"','""')+'"',;
        aFieldInfo[nFieldNum,2]=="D", '"'+DTOC(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
        aFieldInfo[nFieldNum,2]=="T", '"'+TTOC(EVALUATE(aFieldInfo[nFieldNum,1]))+'"',;
        '"'+TRANSFORM(EVALUATE(aFieldInfo[nFieldNum,1]))+'"')
    RETURN cMem
ENDFUNC
2018-03-25 10:22
mywisdom88
Rank: 16Rank: 16Rank: 16Rank: 16
等 级:版主
威 望:86
帖 子:2590
专家分:6355
注 册:2015-3-25
  得分:0 
吹版,真棒。
经过你这样处理后,原来的数据不变,如 物料名称= "名称
导出到EXCEL后,还是 物料名称= "名称
比你27楼更加好,你27楼是用 全角的“代替 半角 "
不过,还没看明白,粘贴板上的内容是 """测试双引号AB""CD"" ,怎么到EXECL后是 "测试双引号AB"CD"

[此贴子已经被作者于2018-3-25 15:05编辑过]

2018-03-25 14:07
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:169
帖 子:6389
专家分:28017
注 册:2014-5-20
  得分:0 
回复 32楼 mywisdom88
一次复制一页的数据记录。
将DBF里的双引号字符 " 改为 ""(变为两个),""(两个双引号)粘贴到EXCEL时被当作一个双引号来处理的,是为区分分隔符的双引号。
这个问题可以在EXCEL中引证:
1、在EXCEL输入下面内容,选择“复制”
   
2、在VFP命令窗口输入:
    ?TRANSFORM(STRCONV(_CLIPTEXT,15), "@RL "+REPLICATE("## ", 100))
显示剪贴板的内容:
   
其中的 22 (0x22)就是双引号字符码。

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

附件: 您没有浏览附件的权限,请 登录注册
2018-03-25 15:08
jyliufeng
Rank: 1
来 自:山东省巨野县
等 级:新手上路
威 望:1
帖 子:12
专家分:0
注 册:2004-11-9
  得分:0 
回复 10楼 吹水佬
一对多的关系表格,导出EXCEL表格可以合并单元格吗。
2018-04-22 20:46
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:169
帖 子:6389
专家分:28017
注 册:2014-5-20
  得分:0 
以下是引用jyliufeng在2018-4-22 20:46:40的发言:

一对多的关系表格,导出EXCEL表格可以合并单元格吗。

理论上肯定是可以的,但就不能用上面的整页整块复制粘贴方法,要根据每个单元的数据属性来处理,相对较复杂、速度慢。
2018-04-23 04:41
cfab
Rank: 1
等 级:新手上路
帖 子:20
专家分:1
注 册:2008-8-14
  得分:0 
学习了。关注关注。
2018-12-07 01:00







关于我们 | 广告合作 | 编程中国 | 清除Cookies | TOP | 手机版

编程中国 版权所有,并保留所有权利。
Powered by Discuz, Processed in 0.031302 second(s), 9 queries.
Copyright©2004-2018, BCCN.NET, All Rights Reserved