回复 楼主 sylknb
你所提的问题，实际上是“分类统计”的范畴，我有一程序，能够以任意多个字段为统计条件组合，分别统计出每个分类的记录个数，具有高度的通用性，可用于任何数据库，进行反复多轮次的分类统计工作。
使用方法：VFP下打开数据表，do 程序1，在字段列表中按顺序选择你要的字段组合（如你要的人员编号、姓名），“选择结束”退出字段选择后，即可看到统计结果。
SQL与运行环境、版本都有些关系，难于做出高度通用的程序。
*本程序用于分类统计,lstran记录的结果可能存在分类字段排列顺序不正确的问题.
private all
set escape off
set talk off
set scoreboard off
set status off
set safety off
set exact on
jgzdh=1
do while jgzdh<=fcount(1)
if upper(field(jgzdh))="FL_TJGS".or.field(jgzdh)="总体".or.field(jgzdh)="统计结果".or.field(jgzdh)="百分比".or.field(jgzdh)="轮次"
set color to +7/1
clear
jhh=1
do while jhh<=len(dbf(1))
if left(right(dbf(1),jhh),1)<>"\"
jhh=jhh+1
else
gdhh=lower(right(dbf(1),jhh-1))
exit
endif
enddo
gdhh="["+gdhh+"]库有["+field(jgzdh)+"]字段,不能运行本程序."
wait gdhh window at 16,(120-len(gdhh))/2 nowait
tdsj=inkey(1)
wait clear
return
endif
jgzdh=jgzdh+1
enddo
set color to +7/1,+6/4
clear
if upper(right(dbf(1),10))="LSTRAN.DBF"
wait "不能在LSTRAN库中运行本程序" window at 16,51 nowait
tdsj=inkey(1)
wait clear
return
endif
yskm=dbf(1)
copy to bjk-ext structure extended
use
messagebox("附加统计条件可改变百分比计算基数,"+CHR(13)+"多轮统计分类关键字应由细类到大类.",0,"综合分类统计")
use bjk-ext
append blank
replace field_name with "总体"
replace field_len with 10
replace field_type with "Number"
replace field_dec with 0
append blank
replace field_name with "统计结果"
replace field_len with 10
replace field_type with "Number"
replace field_dec with 0
append blank
replace field_name with "百分比"
replace field_len with 10
replace field_type with "Number"
replace field_dec with 2
append blank
replace field_name with "轮次"
replace field_len with 10
replace field_type with "Number"
replace field_dec with 0
append blank
replace field_name with "fl_tjgs"
replace field_len with 30
replace field_type with "Character"
replace field_dec with 0
create lszlpxk1 from bjk-ext
use
sma=30
dhzd1=""
tjcsz=space(126)
if file(yskm)
use &yskm
dimension name1(300),jgfh(300),meti(300)
qxh=1
do while qxh<=fcount()
store space(5)+field(qxh)+space(13-len(field(qxh))) to meti(qxh)
qxh=qxh+1
enddo
store space(5)+"选择结束"+space(5) to meti(qxh)
use
else
clear
wait "数据库不存在,退出." window at 16,50 nowait
tdsj=inkey(1)
use
set color to +7/1
clear
return
endif
qxh=1
zd=1
ydlh1=1
jhdh1=1
csm=1
whxh=1
jhh=1
do while whxh<>7
set color to +7/1,+6/4
clear
use &yskm
@22,5 say "PgUp键上页
PgDn键下页
↑键上一字段
↓键下一字段
Enter键确认"
@2,8.7 clear to 21,30
@2,47 clear to 21,68
set color to +7/6
@2,8.7 clear to 21,30
@2,47 clear to 21,68
@2,8.7 to 21,30
@2,47 to 21,68
@3,12 say "请选择统计字段"
@3,52 say "选中的字段有"
set color to +7/3,+6/4
@5,10 clear to 20.4,28.7
store 1 to pk
store space(10) to name1
store "," to jgfh
cxhh=1
if fcount()>14
if qxh>15
do while ydlh1<=qxh
if ydlh1=qxh
@cxhh+4,10 prompt meti(ydlh1)
else
@cxhh+4,10 say meti(ydlh1)
endif
cxhh=cxhh+1
ydlh1=ydlh1+1
enddo
else
do while ydlh1<=15
if ydlh1=jhdh1
@cxhh+4,10 prompt meti(ydlh1)
else
@cxhh+4,10 say meti(ydlh1)
endif
cxhh=cxhh+1
ydlh1=ydlh1+1
enddo
endif
else
do while ydlh1<=fcount()+1
if ydlh1=jhdh1
@cxhh+4,10 prompt meti(ydlh1)
else
@cxhh+4,10 say meti(ydlh1)
endif
cxhh=cxhh+1
ydlh1=ydlh1+1
enddo
endif
keyboard chr(13)
menu to jhdh1
do while .t.
anke=inkey(0)
do case
case anke=5.and.qxh>1.and.qxh<=fcount()+1
qxh=qxh-1
case anke=5.and.qxh=1
qxh=fcount()+1
case anke=24.and.qxh>=1.and.qxh<fcount()+1
qxh=qxh+1
case anke=24.and.qxh=fcount()+1
qxh=1
case anke=3
if qxh+14<=fcount()+1
qxh=qxh+14
else
qxh=fcount()+1
endif
case anke=18
if qxh-14>=1
qxh=qxh-14
else
qxh=1
endif
endcase
if qxh>15
ydlh=qxh-14
jhdh=15
else
ydlh=1
jhdh=qxh
endif
cxhh=1
set color to +7/3,+6/4
@5,10 clear to 20.4,28.7
if fcount()>14
if qxh>15
do while ydlh<=qxh
if ydlh=qxh
@cxhh+4,10 prompt meti(ydlh)
else
@cxhh+4,10 say meti(ydlh)
endif
cxhh=cxhh+1
ydlh=ydlh+1
enddo
else
do while ydlh<=15
if ydlh=jhdh
@cxhh+4,10 prompt meti(ydlh)
else
@cxhh+4,10 say meti(ydlh)
endif
cxhh=cxhh+1
ydlh=ydlh+1
enddo
endif
else
do while ydlh<=fcount()+1
if ydlh=jhdh
@cxhh+4,10 prompt meti(ydlh)
else
@cxhh+4,10 say meti(ydlh)
endif
cxhh=cxhh+1
ydlh=ydlh+1
enddo
endif
keyboard chr(13)
menu to jhdh
zd=qxh
if zd<>fcount()+1.and.anke=13
csm=zd
endif
ozj=pk
sdh=0
do while ozj>=1
if field(zd)<>name1(ozj)
ozj=ozj-1
else
sdh=sdh+1
ozj=ozj-1
endif
enddo
set color to +7/6
if zd<>fcount()+1.and.sdh=0.and.anke=13
if type(field(zd))<>"L".and.type(field(zd))<>"M".and.type(field(zd))<>"G"
store field(zd) to name1(pk)
if pk<=15.and.anke=13
@pk+4,54 say trim(name1(pk))
endif
if pk>15.and.anke=13
vehp=pk-14
inhm=1
do while vehp<=pk
@inhm+4,54 say space(13)
@inhm+4,54 say trim(name1(vehp))
vehp=vehp+1
inhm=inhm+1
enddo
endif
pk=pk+1
else
set color to +7/1
@24,20 say "记忆型/逻辑型/通用型字段不能作为统计条件"
endif
endif
if zd=fcount()+1.and.anke=13
qxh=csm
if qxh>15
ydlh1=qxh-14
jhdh1=15
else
ydlh1=1
jhdh1=qxh
endif
exit
endif
set color to +7/1,+6/4
enddo
set color to +7/6
if zd=fcount()+1.and.anke=13.and.pk=1
@7,51 say "未 选 择 字 段"
@9,51 say "按第一个非L非G"
@11,51 say "和非M型字段为"
@13,51 say "统
计
条
件"
tdsj=inkey(1)
pkgd=1
do while pkgd<=fcount()
if type(field(pkgd))<>"L".and.type(field(pkgd))<>"M".and.type(field(pkgd))<>"G"
store field(pkgd) to name1(pk)
pk=pk+1
qxh=pkgd
if qxh>15
ydlh1=qxh-14
jhdh1=15
else
ydlh1=1
jhdh1=qxh
endif
exit
endif
pkgd=pkgd+1
enddo
endif
num=pk
dhzd=""
pk=1
if num=1
set color to +7/6
@5,49 clear to 19,67
@7,52 say "未找到合法的"
@9,52 say " 统计关键字"
@11,52 say " 退
出"
tdsj=inkey(2)
use
erase bjk-ext.dbf
erase bjk-ext.fpt
erase lszlpxk1.dbf
erase lszlpxk1.fpt
set color to +7/1
clear
return
else
jgfh(num-1)=""
do while pk<num
dhzd=dhzd+name1(pk)+jgfh(pk)
if upper(left(dhzd1,at(",",dhzd1)))<>upper(name1(pk)+",").and.(.not.(","+upper(name1(pk))+",")$upper(dhzd1))
dhzd1=dhzd1+name1(pk)+","
endif
pk=pk+1
enddo
endif
set color to +7/1
clear
define windows win1 from 2,8 to 28,92 system title "分类统计的记录范围" color scheme 1
activate windows win1
move windows win1 center
@1,1,23,13 box space(9)
@2,3 say "库 字 段"
@3,3 say "提
示"
@4,3 say "────"
xzds=1
do while xzds<=fcount().and.xzds<=18
@xzds+4,2 say field(xzds)
xzds=xzds+1
enddo
@9,38 say "请输入分类统计的附加条件"
@13,17 get tjcsz color ,+6/4
set cursor on
read
set cursor off
clear gets
release windows win1
clear
use
use bjk-ext
go bottom
if len(trim(tjcsz))+20>sma
replace field_len with len(trim(tjcsz))+20
create lsbjczk from bjk-ext
append from lszlpxk1
copy to lszlpxk1
sma=len(trim(tjcsz))+20
else
if len(trim(tjcsz))+20>=30
replace field_len with len(trim(tjcsz))+20
else
replace field_len with 30
endif
endif
create lsbjczk from bjk-ext
if trim(tjcsz)<>""
clear
wait "统计范围:"+trim(tjcsz) window at 16,(126-len("统计范围:"+trim(tjcsz)))/2 nowait
tdsj=inkey(1)
append from &yskm for &tjcsz
wait clear
else
clear
wait "条件为空将默认全部" window at 16,50 nowait
tdsj=inkey(1)
append from &yskm
wait clear
endif
set color to +7/1,+6/4
clear
copy structure to lstran field &dhzd,总体,统计结果,百分比,轮次,fl_tjgs
jgzdh=messagebox("是否进行全库排序?",4+32+0,"记录排序")
if jgzdh=6
wait "正在进行分类排序" window at 16,48 nowait
tdsj=inkey(0.5)
sort to lsbjpxk on &dhzd
wait clear
else
wait "正在整理分类数据" window at 16,48 nowait
tdsj=inkey(0.5)
copy to lsbjpxk
wait clear
endif
use
clear
jlzzi=1
@5,25 say "正在进行分类统计"
@8,25 say "正在统计第"
@8,45 say "类数据"
use lsbjpxk
samtol=reccount(1)
jdt=25
go top
do while .not.eof()
@8,35 say str(jlzzi)
pk=1
do while pk<num.and.pk<10
nagdxs=name1(pk)
@9+pk,25 say name1(pk)+":"
@9+pk,35 say &nagdxs
pk=pk+1
enddo
pk=1
jgfh=""
do while pk<num
nagdxs=name1(pk)
store &nagdxs to jgfh(pk)
pk=pk+1
enddo
if .not.eof()
skip
endif
cfgsj=1
do while .not.eof()
pk=1
qdpdh=0
do while pk<num
pdnadh=name1(pk)
if &pdnadh<>jgfh(pk)
qdpdh=qdpdh+1
endif
pk=pk+1
enddo
if qdpdh=0
cfgsj=cfgsj+1
skip
else
exit
endif
enddo
if recno(1)>reccount(1)
gdhh=(recno(1)-1)*64.4/reccount(1)+25
@20,25 say "第["+ltrim(str(jlzzi))+"]类记录共"+ltrim(str(cfgsj))+"个,已完成:"+ltrim(str((recno(1)-1)*100/reccount(1),10,2))+"%
"
else
gdhh=recno(1)*64.4/reccount(1)+25
@20,25 say "第["+ltrim(str(jlzzi))+"]类记录共"+ltrim(str(cfgsj))+"个,已完成:"+ltrim(str(recno(1)*100/reccount(1),10,2))+"%
"
endif
do while jdt<=gdhh
set color to +6/1
@21,jdt to 22,90 pen 2
jdt=jdt+0.1
set color to +7/1
enddo
jdt=jdt-0.1
tdsj=inkey()
if eof(1)
tdsj=inkey(1)
endif
sele 2
use lstran
append blank
go bottom
pk=1
do while pk<num
tjzddh=name1(pk)
replace &tjzddh with jgfh(pk)
pk=pk+1
enddo
replace fl_tjgs with str(cfgsj)+"个"+str(int(cfgsj*10000/samtol+0.5)/100,10,2)+"%"
replace 统计结果 with cfgsj
replace 百分比 with int(cfgsj*10000/samtol+0.5)/100
replace 总体 with samtol
replace 轮次 with jhh
use
sele 1
jlzzi=jlzzi+1
enddo
sele 1
use
use lstran
append blank
if trim(tjcsz)<>""
replace fl_tjgs with "统计范围:"+trim(tjcsz)+"("+ltrim(str(samtol))+"条)"
else
replace fl_tjgs with "统计范围:所有库记录"+"("+ltrim(str(samtol))+"条)"
endif
replace 总体 with samtol
replace 统计结果 with samtol
replace 轮次 with jhh
if samtol>0
replace 百分比 with 100
else
replace 百分比 with 0
endif
go top
set color to +7/1,+6/4
clear
wait "以下是分类统计的结果" window at 16,52 nowait
tdsj=inkey(1)
brow
use
use lszlpxk1
append from lstran
use
set color to +7/1,+6/4
clear
whxh=messagebox("继续进行分类统计?",4+32+0,"数据统计")
jhh=jhh+1
enddo
jgzdh=messagebox("是否保留分类统计的注释信息?",4+32+0,"分类统计")
if jgzdh=6
dhzd1=dhzd1+"总体,统计结果,百分比,轮次,fl_tjgs"
if right(dhzd1,1)=","
dhzd1=left(dhzd1,len(dhzd1)-1)
endif
use lszlpxk1
copy to lstran field &dhzd1
else
dhzd1=dhzd1+"总体,统计结果,百分比,轮次"
if right(dhzd1,1)=","
dhzd1=left(dhzd1,len(dhzd1)-1)
endif
use lszlpxk1
delete all for "范围"$fl_tjgs
if upper(right(yskm,10))<>"LSDELE.DBF"
copy to lsdele for deleted()
endif
pack
copy to lstran field &dhzd1
endif
use lstran
messagebox("历次统计结果存于LSTRAN.DBF库，进行后续数据处理？",0,"分类统计")
use &yskm
erase bjk-ext.dbf
erase bjk-ext.fpt
erase lsbjczk.dbf
erase lsbjczk.fpt
erase lsbjpxk.dbf
erase lsbjpxk.fpt
erase lszlpxk1.dbf
erase lszlpxk1.fpt
set color to +7/1
clear
return
[
本帖最后由 沙枣 于 2015-9-25 10:25 编辑 ]
你的别名在哪里