回复 楼主 sylknb
以下的程序段可以删除当前数据表中的空记录和重复记录(重复记录只保留一条),VFP下打开要整理的数据表,do 程序1即可。
private all
set talk off
set scoreboard off
set safety off
set color to +7/1
clear
sele 1
yskm=dbf(1)
jgzdh=1
do while jgzdh<=fcount(1)
if upper(field(jgzdh))="ZL_JLH"
set color to +7/1
clear
wait "数据库含有ZL_JLH字段,不能运行本程序." window at 16,50 nowait
tdsj=inkey(1)
exit
endif
jgzdh=jgzdh+1
enddo
if upper(field(jgzdh))="ZL_JLH"
use
loop
endif
set color to +7/1,+6/4
clear
jgzdh=messagebox("“自动整理”程序将删除当前库的重复记录和空记录,确认?",4+32+0,"数据整理")
do case
case jgzdh=6
jgzdh="y"
case jgzdh=7
jgzdh="n"
otherwise
clear
wait "程序发生错误,返回." window at 16,48 nowait
return
endcase
if upper(jgzdh)<>"Y"
wait "放弃数据整理,返回." window at 16,50 nowait
use
loop
endif
clear
wait "正在整理数据,请耐心等待..." window at 16,50 nowait
pk=1
pxname=""
do while pk<=fcount()
if upper(type(field(pk)))<>"M".and.upper(type(field(pk)))<>"L".and.upper(type(field(pk)))<>"G"
if pk<fcount()
pxname=pxname+field(pk)+","
endif
if pk=fcount()
pxname=pxname+field(pk)
endif
endif
pk=pk+1
enddo
pk=1
do while pk<=fcount()
if type(field(pk))="M".or.type(field(pk))="G"
wait clear
zlxzh=messagebox("数据库中含有M/G型字段"+chr(13)+"数据整理结果可能不正确"+chr(13)+"继续进行数据整理?",4+32+0,"数据整理")
do case
case zlxzh=6
zlxzh="y"
case zlxzh=7
zlxzh="n"
otherwise
clear
wait "程序发生错误,返回." window at 16,48 nowait
return
endcase
if upper(zlxzh)<>"Y"
set color to +7/1
clear
use
wait clear
return
else
clear
wait "正在整理数据,请耐心等待..." window at 16,50 nowait
tdsj=inkey(1)
exit
endif
endif
pk=pk+1
enddo
copy to pxzl-ext structure extended
use
use pxzl-ext
locate for upper(field_name)="ZL_JLH"
if found()
wait '表列名[ZL_JLH]与系统冲突' window at 16,50 nowait
use
erase pxzl-ext.dbf
erase pxzl-ext.fpt
return
endif
append blank
replace field_name with "zl_jlh"
replace field_type with "Number"
replace field_len with 10
replace field_dec with 0
create lszlczk from pxzl-ext
append from &yskm
go top
replace all zl_jlh with recno()
if right(pxname,1)=","
pxname=pxname+"zl_jlh"
else
pxname=pxname+",zl_jlh"
endif
sort to pxzlkm1 on &pxname
use
use pxzlkm1
go top
if .not.eof()
count to mbjlnu2
go 1
insert blank before
go top
jdt=25
wait clear
do while .not.eof()
scatter to rec1
skip
do while .not.eof()
gdhh=recno()*64.4/reccount()+25
@12,48 say "数据整理进度:"+ltrim(str(recno()*100/reccount(),10,2))+"%
"
do while jdt<=gdhh
set color to +6/1
@13,jdt to 14,90 pen 2
jdt=jdt+0.1
set color to +7/1
enddo
jdt=jdt-0.1
tdsj=inkey()
if recno()/reccount()=1
tdsj=inkey(1)
endif
scatter to rec2
swic=0
cir=1
cir1=1
do while cir1<fcount(1)
if type(field(cir1))="M".or.type(field(cir1))="G"
swic=swic+1
*数组中缺少记忆型字段单元,一律认为相等,加计数一次.
else
if type("rec1(cir)")<>"L"
if rec1(cir)=rec2(cir)
swic=swic+1
else
exit
endif
else
if ((.not.rec1(cir)).and.(.not.rec2(cir))).or.(rec1(cir).and.rec2(cir))
swic=swic+1
else
exit
endif
endif
cir=cir+1
endif
cir1=cir1+1
enddo
if swic=fcount(1)-1
delete
skip
endif
if swic<fcount(1)-1
exit
endif
enddo
enddo
if upper(right(trim(yskm),12))<>"LSREPORT.DBF"
copy to lsreport for deleted()
endif
delete all for recno()=1
pack
pk=1
do while pk<fcount()
if type(field(pk))="C"
store field(pk) to rqmc
replace all &rqmc with ltrim(&rqmc)
endif
if type(field(pk))="D".or.type(field(pk))="T"
store field(pk) to rqmc
count all to inzl1 for year(&rqmc)>=1900.and.year(&rqmc)<=1920
if inzl1>0
inzl2=messagebox("发现D/T型字段[&rqmc.]的可疑年份(1900-1920),纠正可疑年份?",4+32+0,"数据整理")
if inzl2=6
jlhh=1
do while jlhh<=reccount()
go jlhh
store year(&rqmc) to ndjs
if ndjs>=1900.and.ndjs<=1920
if type(field(pk))="D"
replace &rqmc with ctod(left(dtoc(&rqmc),6)+ltrim(str(ndjs+100))) for year(&rqmc)=ndjs
else
replace &rqmc with ctot(left(ttoc(&rqmc),6)+ltrim(str(ndjs+100))) for year(&rqmc)=ndjs
endif
endif
jlhh=jlhh+1
enddo
endif
endif
count all to inzl1 for year(&rqmc)>year(date())
if inzl1>0
inzl2=ltrim(str(inzl1))
messagebox("发现&inzl2.条记录的D/T型字段[&rqmc.]的年份大于当前日期["+dtoc(date())+"]的年份",0,"数据整理")
endif
endif
pk=pk+1
enddo
count to mbjlnu4
if mbjlnu2-mbjlnu4>=1
clear
scjlgs=ltrim(str(mbjlnu2-mbjlnu4))
hn="共有&scjlgs.条非法记录被删除"
wait hn window at 16,(120-len(hn))/2 nowait
tdsj=inkey(1)
endif
sort to pxzlkm2 on zl_jlh
use
use pxzl-ext
go bottom
delete
pack
create lszlczk from pxzl-ext
append from pxzlkm2
copy to &yskm
use
use &yskm
set color to +7/1
clear
wait "数据整理完毕,开始浏览." window at 16,50 nowait
tdsj=inkey(0.5)
brow
use
use lsreport
recall all
go top
if (.not.eof()).and.upper(right(trim(yskm),12))<>"LSREPORT.DBF"
clear
wait "以下是被删除的数据,可从lsreport库召回." window at 16,48 nowait
tdsj=inkey(1)
brow
use
else
use
endif
else
use
clear
wait "数据库中无记录" window at 16,50 nowait
tdsj=inkey(1)
endif
erase pxzl-ext.dbf
erase pxzl-ext.fpt
erase lszlczk.dbf
erase lszlczk.fpt
erase pxzlkm1.dbf
erase pxzlkm1.fpt
erase pxzlkm2.dbf
erase pxzlkm2.fpt
return