回复 15楼 su0527
你这个问题说难不难，说简单不简单，需要专门的程序处理，参考以下代码，可用于任何结构的数据表（通用），XP/VFP6.0下测试通过。
使用方法：打开要检查的数据表（自由表），运行程序，逐个选取你要检查的字段，在“选择结束”敲回车后，即可看到你要的结果，运行结果只显示同值字段组合出现2次或2次以上的，只出现1次的不显示。
private all
set escape off
set talk off
set scoreboard off
set status off
set exact on
set safety off
dimension meti(300),name1(300),jgfh(300)
yskm=dbf(1)
recall all
tjcsz="recno()>=1"
jgzdh=1
do while jgzdh<=fcount(1)
if upper(field(jgzdh))="FL_TJGS".or.field(jgzdh)="总体".or.field(jgzdh)="重码个数".or.field(jgzdh)="百分比"
set color to +7/1
clear
gdhh="数据库含有["+field(jgzdh)+"]字段,不能运行本程序."
wait gdhh window at 16,52 nowait
tdsj=inkey(1)
exit
endif
jgzdh=jgzdh+1
enddo
if upper(field(jgzdh))="FL_TJGS".or.field(jgzdh)="总体".or.field(jgzdh)="重码个数".or.field(jgzdh)="百分比"
loop
endif
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)
@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,zd
store space(10) to name1
store "," to jgfh
qxh=1
do while qxh<=fcount()+1.and.qxh<=15
if zd=qxh
@qxh+4,10 prompt meti(qxh)
else
@qxh+4,10 say meti(qxh)
endif
qxh=qxh+1
enddo
keyboard chr(13)
menu to zd
qxh=1
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
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
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
exit
endif
pkgd=pkgd+1
enddo
endif
num=pk
dhzd=""
pk=1
if num=1
@5,49 clear to 20,67
@7,52 say "未找到合法的"
@9,52 say " 被检关键字"
@11,52 say " 返
回"
tdsj=inkey(2)
set color to +7/1
clear
use
loop
else
jgfh(num-1)=""
do while pk<num
dhzd=dhzd+name1(pk)+jgfh(pk)
pk=pk+1
enddo
endif
copy to bjk-ext structure extended
use
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 "fl_tjgs"
replace field_len with 30
replace field_type with "Character"
replace field_dec with 0
create lsbjczk from bjk-ext
append from &yskm
set color to +7/1
clear
jlzzi=1
@4,25 say "正在全库范围内进行重码检查"
@8,25 say "正在检查第"
@8,45 say "类数据"
copy structure to lstran field &dhzd,总体,重码个数,百分比,fl_tjgs
sort to lsbjpxk on &dhzd
use
use lsbjpxk
jdt=25
samtol=reccount(1)
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()<=reccount()
gdhh=recno()*64.4/reccount()+25
@20,48 say "数据检查进度："+ltrim(str(recno()*100/reccount(),10,2))+"%
"
else
gdhh=(recno()-1)*64.4/reccount()+25
@20,48 say "数据检查进度："+ltrim(str((recno()-1)*100/reccount(),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 总体 with samtol
replace 重码个数 with cfgsj
replace 百分比 with int(cfgsj*10000/samtol+0.5)/100
replace fl_tjgs with str(cfgsj)+"个"+str(int(cfgsj*10000/samtol+0.5)/100,10,2)+"%"
use
sele 1
jlzzi=jlzzi+1
enddo
sele 1
use
sele 2
use lstran
append blank
if samtol>0
replace 总体 with samtol
replace 重码个数 with samtol
replace 百分比 with 100.00
replace fl_tjgs with "检查范围:所有库记录("+ltrim(str(samtol))+"条)"
else
replace fl_tjgs with "库中无记录"
endif
use
sele 1
set color to +7/1
clear
use lstran
delete all for 重码个数<=1
go bottom
delete
pack
go top
wait "以下是重码检查的结果,保存于lstran库中。" window at 16,40 nowait
tdsj=inkey(1)
brow
use
erase bjk-ext.dbf
erase bjk-ext.fpt
erase lsbjczk.dbf
erase lsbjczk.fpt
erase lsbjpxk.dbf
erase lsbjpxk.fpt
RETURN
