标题:求各部门名册人数
只看楼主
杂七杂八
Rank: 1
等 级:新手上路
帖 子:217
专家分:7
注 册:2018-2-20
得分:0 
考虑到excel 表格文件数目多少不确定,还不能把filenam里fname字段内容固定。
2021-08-22 23:29
杂七杂八
Rank: 1
等 级:新手上路
帖 子:217
专家分:7
注 册:2018-2-20
得分:0 
程序代码:
set safety OFF   
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)

CREATE tabl filenam(fname c(30),rs n(4))

 aa=ADIR(mm,'*.xls')   

 FOR nn=1 to aa
      M_File=juststem(cDefPath+mm(nn,1))
     INSERT INTO filenam (fname) VALUES (M_File)
  ENDFOR
REPLACE ALL rs WITH fun()
BROWSE
USE
RETURN

FUNCTION fun()
    xlsx = cDefPath + ALLTRIM(fname)
    oExcel = CREATEOBJECT('Excel.Application')
    oExcel.DisplayAlerts = 0
    oExcel.WorkBooks.Open(xlsx)
    oAS = oExcel.ActiveSheet
    ret = oExcel.CountA(oAS.Range("B:B")) - 1
    oExcel.WorkBooks.Close
    oExcel.Quit 
    RETURN ret
ENDFUNC
2021-08-23 05:52
杂七杂八
Rank: 1
等 级:新手上路
帖 子:217
专家分:7
注 册:2018-2-20
得分:0 
在老师的代码上,自行修改了一下。
想在最后一行加上:合计人数。没有成功。
2021-08-23 05:55
杂七杂八
Rank: 1
等 级:新手上路
帖 子:217
专家分:7
注 册:2018-2-20
得分:0 
程序代码:
set safety OFF   
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)

CREATE tabl filenam(fname c(30),rs n(4))

 aa=ADIR(mm,'*.xls')   

 FOR nn=1 to aa
      M_File=juststem(cDefPath+mm(nn,1))
     INSERT INTO filenam (fname) VALUES (M_File)
  ENDFOR
REPLACE ALL rs WITH fun()

insert into filenam (fname) values ("合计")
     sele sum(rs) from filenam into array kk
     replace rs  with KK  for fname='合计'
BROWSE

USE
RETURN

FUNCTION fun()
    xlsx = cDefPath + ALLTRIM(fname)
    oExcel = CREATEOBJECT('Excel.Application')
    oExcel.DisplayAlerts = 0
    oExcel.WorkBooks.Open(xlsx)
    oAS = oExcel.ActiveSheet
    ret = oExcel.CountA(oAS.Range("B:B")) - 1
    oExcel.WorkBooks.Close
    oExcel.Quit 
    RETURN ret
ENDFUNC

代码还能优化吗?谢谢
2021-08-23 06:19
杂七杂八
Rank: 1
等 级:新手上路
帖 子:217
专家分:7
注 册:2018-2-20
得分:0 
用VFP6.0的
2021-08-23 06:21
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:432
帖 子:10064
专家分:41463
注 册:2014-5-20
得分:15 
回复 14楼 杂七杂八

程序代码:
set safety OFF   
cDefPath = ADDBS(JUSTPATH(SYS(16)))
SET DEFAULT TO (cDefPath)

aa=ADIR(mm,'*.xls')
CREATE CURSOR filenam (fname c(30))
INSERT INTO filenam FROM ARRAY mm 
SELECT fname, 0000 as rs FROM filenam INTO CURSOR rstj READWRITE 
oExcel = CREATEOBJECT("Excel.Application")
oExcel.DisplayAlerts = 0
nCount = 0
REPLACE ALL rs WITH fun() IN "rstj"
INSERT INTO rstj VALUES ("合计",nCount)
oExcel.Quit
SELECT * FROM rstj
RETURN

FUNCTION fun()
    oExcel.WorkBooks.Open(cDefPath + ALLTRIM(rstj.fname))
    oAS = oExcel.ActiveSheet
    ret = oExcel.CountA(oAS.Range("B:B")) - 1
    oExcel.WorkBooks.Close
    nCount = nCount + ret
    RETURN ret
ENDFUNC


[此贴子已经被作者于2021-8-23 09:20编辑过]

2021-08-23 09:16
杂七杂八
Rank: 1
等 级:新手上路
帖 子:217
专家分:7
注 册:2018-2-20
得分:0 
SELECT fname, 0000 as rs FROM filenam INTO CURSOR rstj READWRITE  &&&&出现程序错误“命令中有不能识别的短语或关键字”对话框
2021-08-23 17:09
吹水佬
Rank: 20Rank: 20Rank: 20Rank: 20Rank: 20
等 级:版主
威 望:432
帖 子:10064
专家分:41463
注 册:2014-5-20
得分:0 
回复 17楼 杂七杂八
可能是VFP6兼容问题
改几句
**    CREATE CURSOR filenam (fname c(30))
**    INSERT INTO filenam FROM ARRAY mm
**    SELECT fname, 0000 as rs FROM filenam INTO CURSOR rstj READWRITE

CREATE CURSOR rstj (fname c(30))
INSERT INTO rstj FROM ARRAY mm
ALTER TABLE rstj ADD rs I
2021-08-23 21:07
xuminxz
Rank: 11Rank: 11Rank: 11Rank: 11
等 级:贵宾
威 望:40
帖 子:749
专家分:2475
注 册:2011-5-8
得分:1 
回复 17楼 杂七杂八
SELECT fname, 0000 as rs FROM filenam INTO CURSOR rstj READWRITE  &&&&出现程序错误“命令中有不能识别的短语或关键字”对话框
VFP6.0中,select 建立的临时表,不支持ReadWrite,不能更新。

dBase有人接盘了。
2021-08-24 10:45



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




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

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