标题:kimhoo分享:prg程序方式导入EXCEL表格至dbf代码分享
只看楼主
kimhoo
Rank: 2
等 级:论坛游民
威 望:3
帖 子:59
专家分:37
注 册:2017-5-31
结帖率:66.67%
已结贴  问题点数:20 回复次数:2 
kimhoo分享:prg程序方式导入EXCEL表格至dbf代码分享
大嘎猴,由于在工作中经常用到EXCEL表格转DBF,再通过ODBC取数到WPS表格作报表呈现及数据处理,特分享一段代码方式将EXCEL表导入DBF表(非远程视图),相信分享的力量,不足之处欢迎拍砖:
***设置当前工作目录为默认
SET DEFAULT TO SYS(5) + SYS(2003)+"\"

***关闭删除提示
SET SAFETY OFF

***开始时间
CLEAR
use
dtime1=SECONDS() &&记录操作开始时间秒
dstart=DATETIME()
OPEN DATABASE SYS(5) + SYS(2003) + "\database\dblist.dbc"
IF FILE('tablist.dbf')
   REMOVE TABLE tablist DELETE
endif
IF FILE('tablist2.dbf')
    REMOVE TABLE tablist2 DELETE
endif
IF !file('tablist.dbf')
    *****MESSAGEBOX("主表tblist不存在,将根据模板建立数据库基表tablist")
***创建并打开EXCEL对象供提取表头用
    oExcel = CREATEOBJECT('Excel.Application')
    WITH oExcel
        .WorkBooks.Open(SYS(5) + SYS(2003) + "\EXCEL\EXCEL样表.Xlsx")
        .ActiveSheet.UsedRange.Select
        WITH .Selection
            .Columns.AutoFit
            nRow = .Rows.Count
            nColumn = .Columns.Count - 0
            PUBLIC arrayName[nRow, nColumn]  &&定义数组
            arrayName = .Cells(1, 1).Resize(1,nColumn).Value  &&为数组赋值
        ENDWITH
        .DisplayAlerts = .f. &&关闭报警提示信息
        .WorkBooks.Close &&关闭工作簿
        .Quit    &&退出工作EXCEL表格对象
    ENDWITH

    **提取表头
    CLEAR &&清屏
    lcStr = "公司代码 c(50)" &&为表格(1, 1)第一个字段
    FOR lnj = 1 TO nColumn STEP 1  &&遍历表格定义字段
        lcStr = lcStr + ", F" + transform(lnj) + " C(50)"  &&设置字段名称
    ENDFOR
    CREATE cursor test (&lcStr) &&创建虚拟暂存表1
    INSERT INTO test FROM ARRAY ArrayName &&从数组中提取数据到 虚拟暂存表1
    LOCATE &&将记录指针定位在 虚拟暂存表1的第一个逻辑记录上

    **更新表头为第一行字段
    lcStrr2 = "公司代码 c(50)"
    FOR lnj2 = 2 TO nColumn STEP 1
        ***显示初始字段名?FIELD(lnj2)
        val2=FIELD(lnj2)
        ***显示变量值?&val2
        val3=&val2
        ***显示变量对应表头?"val3列对应->"+val3
        lcStrr2 = lcStrr2 + "," + "&val3" + " C(50)"
        lcStrr2=CHRTRAN(lcStrr2,"/","")
    ENDFOR
    CREATE cursor test2 (&lcStrr2) &&创建虚拟暂存表2
    ZAP &&删除表格内容,只保留表结构


    ***导入表格到数据库形成数据库表
    SELECT * FROM test2  INTO TABLE tablist DATABASE dblist
ENDIF
USE tablist
ZAP &&清空现存表中内容
use

***修改字段长度及转换数据类型
ALTER TABLE Tablist ALTER 公司代码 c(10)
ALTER TABLE Tablist ALTER 公司名称 c(30)
ALTER TABLE Tablist ALTER 下级公司代码 c(10)
ALTER TABLE Tablist ALTER 下级机构名称 c(30)
ALTER TABLE Tablist ALTER 货号 c(20)
ALTER TABLE Tablist ALTER 批次号 c(20)
ALTER TABLE Tablist ALTER 团队 c(20)
ALTER TABLE Tablist ALTER 销售点 c(20)
ALTER TABLE Tablist ALTER 销售方式 c(50)
ALTER TABLE Tablist ALTER 销售人 c(50)
ALTER TABLE Tablist ALTER 区域 c(30)

ALTER TABLE Tablist ALTER  期限 c(10)

ALTER TABLE Tablist ALTER 成交日 D(8)
ALTER TABLE Tablist ALTER 金额 N(10,2)
ALTER TABLE Tablist ALTER 实收 N(10,2)
ALTER TABLE Tablist ALTER 定金 N(10,2)

ALTER TABLE Tablist ALTER 失效时间 D(8)
ALTER TABLE Tablist ALTER 失效时间 NULL  &&设置失效时间允许空值

***重新导入数据
oExcel = CREATEOBJECT('Excel.Application')
WITH oExcel
    .WorkBooks.Open(SYS(5) + SYS(2003) + "\EXCEL\EXCEL样表.Xlsx")
    .ActiveSheet.UsedRange.Select
    WITH .Selection
        .Columns.AutoFit
        nRow = .Rows.Count-1
        nColumn = .Columns.Count - 0
        PUBLIC ArrayName[nRow, nColumn]
        ArrayName2 = .Cells(2, 1).Resize(nRow,nColumn).Value
    ENDWITH
    .DisplayAlerts = .f.
    .WorkBooks.Close
    .Quit   
ENDWITH
INSERT INTO tablist FROM ARRAY ArrayName2

c1=_tally

***生成承保清单和契撤清单、净承保清单

SELECT 公司代码,公司名称,下级公司代码,下级机构名称,货号,批次号,销售点,销售方式,销售人,区域,客户编码,客户姓名,营业编码,所属部名称,区编码,区名称,产品, 成交日 as 统计日期,金额/10000 as 万元金额,实收/10000 as 万元实收,"成交" as 标志 FROM tablist  INTO TABLE tablist2 DATABASE dblist
SELECT 公司代码,公司名称,下级公司代码,下级机构名称,货号,批次号,销售点,销售方式,销售人,区域,客户编码,客户姓名,营业编码,所属部名称,区编码,区名称,产品,成交日, ,失效时间 as 统计日期,-1*金额 as 金额元,-1*实收 AS 实收金额,"退货" as 标志 FROM tablist  WHERE 失效原因 like '%退%' INTO ARRAY arrqc
INSERT INTO tablist2 FROM ARRAY arrqc

c2=_tally

ALTER TABLE Tablist2 ALTER 失效时间 NULL  &&设置失效时间允许空值

c3=_tally
c4=c1+c2+c3

***删除清单表

IF FILE('tablist.dbf')
   REMOVE TABLE tablist DELETE
ENDIF

***结束时间
SECONDS()
***用时
dend=DATETIME()
nlen=SECONDS()-dtime1
INSERT INTO clog(datestart,dateend,datelen,nrecords) values(dstart,dend,nlen,c4)
***用时 MESSAGEBOX(nlen,0+64,STR(c4)+'条记录,用时(秒)')

RELEASE all
CLOSE tables
quit
搜索更多相关主题的帖子: TABLE 名称 代码 公司 EXCEL 
2021-08-14 22:39
schtg
Rank: 11Rank: 11Rank: 11Rank: 11
来 自:https://t.me/pump_upp
等 级:贵宾
威 望:67
帖 子:1355
专家分:2534
注 册:2012-2-29
得分:14 
学习啦,谢谢!
2021-08-15 05:38
kimhoo
Rank: 2
等 级:论坛游民
威 望:3
帖 子:59
专家分:37
注 册:2017-5-31
得分:0 
回复 2楼 schtg
不客气,相互分享学习,共同进步
2021-08-15 19:36



参与讨论请移步原网站贴子:https://bbs.bccn.net/thread-506526-1-1.html




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

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