回复 18楼 wengjl
感谢wengjl版提供的帮助，解决了我的大难题。为了满足学校对高分段学生均衡的要求，考虑前200名12344321蛇形排列，领导初步同意剩下的按wengjl版的方式随机来处理。因水平有限，程序写起来很不简洁，请指教。同时请论坛内高手看看还有更好的方法解决吗
程序代码：***第一步蛇形处理前200名
CLEAR
CLOSE DATABASES
MESSAGEBOX("准备打开需分派的数据表",0+48)
fn1=GETFILE('dbf','打开分派数据库')
USE (fn1) ALIAS bmk IN 0
BLANK FIELDS lqxxdm ALL &&清空录取学校代码字段，测试用
***先取出前200名，12344321蛇形分派
SELECT * FROM bmk ORDER BY zf DESC INTO CURSOR tmp READWRITE &&按总分降序排列
IF TYPE([zfwc])=[U] &&增加总分位次字段
ALTER TABLE tmp ADD zfwc N(8)
ENDIF
UPDATE tmp SET zfwc=(SELECT COUNT(*)+1 FROM tmp AS b WHERE b.zf>tmp.zf) &&排列总分位次字段
IF TYPE([分派号])=[U] &&增加分派号字段
ALTER TABLE tmp ADD 分派号 N(2)
ENDIF
SELECT TOP 200 * FROM tmp ORDER BY zf DESC INTO CURSOR tmp200 READWRITE &&导出前200名临时表
SELECT tmp200
NN=4 &&重要：设定需分派数，此处为4个校区，如需增加减少，替换NN即可，顺序写入分班
REPLACE ALL 分派号 WITH IIF(MOD(RECNO()-1,2*NN)<NN,MOD(RECNO()-1,NN)+1,NN-MOD(RECNO()-1,NN))
SCAN FOR !EMPTY(分派号) &&&&按分派号替换写入录取学校代码lqxxdm
DO CASE
CASE 分派号=1
REPLACE lqxxdm WITH '0100'
CASE 分派号=2
REPLACE lqxxdm WITH '0200'
CASE 分派号=3
REPLACE lqxxdm WITH '0300'
CASE 分派号=4
REPLACE lqxxdm WITH '0400'
ENDCASE
ENDSCAN
*SELECT zkzh,zf,zfwc,分派号,lqxxdm FROM tmp200 ORDER BY zf DESC
*GO TOP
*BROWSE
*SELECT tmp
SELECT lqxxdm,COUNT(*) rs,AVG(zf) pjf GROUP BY 1 FROM tmp200 &&测试查看用
UPDATE tmp FROM tmp200 SET lqxxdm=tmp200.lqxxdm WHERE tmp.zkzh=tmp200.zkzh
UPDATE bmk from tmp200 SET lqxxdm=tmp200.lqxxdm WHERE bmk.zkzh=tmp200.zkzh &&&将前200名录取结果写回原始报名库
SELECT bmk
SELECT * FROM tmp where EMPTY(lqxxdm) INTO cursor tmp2 READWRITE
***第二步，按wengjl版的方式处理剩余数据
LOCAL zss1,zss2,zss3,zss4,lnCnt1,lnCnt2,lnCnt3,lnCnt4,xhkz
MESSAGEBOX("准备打开招生计划库数据表",0+48)
fn2=GETFILE('dbf','打开计划数据库')
USE (fn2) ALIAS zkjhk IN 0
SELECT *,zsrs-50 as zsrs1 FROM zkjhk INTO CURSOR zkjhk1 READWRITE &&减去上面的200人，4给校区各减去50人
COPY TO ARRAY laArr FIELDS zsrs1
*zss1=thisform.cont1.text1.value
*zss2=thisform.cont1.text2.value
*zss3=thisform.cont1.text3.value
*zss4=thisform.cont1.text4.value
zss1=laArr(1)
zss2=laArr(2)
zss3=laArr(3)
zss4=laArr(4)
?zss1 &&测试查看用
?zss2 &&测试查看用
?zss3 &&测试查看用
?zss4 &&测试查看用
xhkz=.T. &&&&循（XUN）环（HUAN）控制变量
SELECT tmp2
*IF RECCOUNT()>zss1+zss2+zss3+zss4
* MESSAGEBOX([color=#FF0000]'待录取的人数大于总招生数，会使程序进入死循环的！！！ 请修改招生计划或修改录取程序！',48,'警告：')[/color]
* [color=#0000FF]RETURN[/color]
*ENDIF
GO TOP
RAND(SECONDS()) &&&& 根据时间秒数的不一，来产生随机数，保证每次启动都不一样
STORE 0 TO lnCnt1,lnCnt2,lnCnt3,lnCnt4 &&& 给四个变量赋初值为0
DO WHIL xhkz &&&& 当循环控制变量为真时循环进行下去
GO TOP
SCAN FOR EMPTY(lqxxdm)
lnRound=RAND()
DO CASE
CASE lnRound<=zss1/(zss1+zss2+zss3+zss4) AND lnCnt1<zss1
lcSchool='0100'
lnCnt1=lnCnt1+1
REPLACE lqxxdm WITH lcSchool
CASE lnRound<=(zss1+zss2)/(zss1+zss2+zss3+zss4) AND lnCnt2<zss2
lcSchool='0200'
lnCnt2=lnCnt2+1
REPLACE lqxxdm WITH lcSchool
CASE lnRound<=(zss1+zss2+zss3)/(zss1+zss2+zss3+zss4) AND lnCnt3<zss3
lcSchool='0300'
lnCnt3=lnCnt3+1
REPLACE lqxxdm WITH lcSchool
CASE lnRound<=(zss1+zss2+zss3+zss4)/(zss1+zss2+zss3+zss4) AND lnCnt4<zss4
lcSchool='0400'
lnCnt4=lnCnt4+1
REPLACE lqxxdm WITH lcSchool
*!* OTHERWISE
*!* lcSchool='0400'
*!* lnCnt4=lnCnt4+1
ENDCASE
ENDSCAN
*--------------
*每完成一次扫描后，检测是否有学生未被录取，有学生未被录取，必有学校未招满学生
nn=0
GO TOP
SCAN
IF EMPTY(lqxxdm)
nn=nn+1
ENDIF
ENDSCAN
IF nn=0 &&&& 如果全部学生都有录取学校了，则改变循环控制变量为假，使循环结束。
xhkz=.F.
ENDIF
ENDDO
*SELECT lqxxdm,COUNT(*) FROM tmp2 GROUP BY 1 &&测试查看用
UPDATE bmk from tmp2 SET lqxxdm=tmp2.lqxxdm WHERE bmk.zkzh=tmp2.zkzh &&&将前200名录取结果写回原始报名库
* 对各校的录取情况进行统计
SELECT bmk
*SELECT lqxxdm,COUNT(*) FROM bmk GROUP BY 1 &&测试查看用
SELECT zkjhk
GO TOP
SCAN
SELECT bmk
sn=0
GO TOP
SCAN
IF bmk.lqxxdm=zkjhk.xxdm
sn=sn+bmk.zf
ENDIF
ENDSCAN
GO TOP
COUNT TO nn FOR bmk.lqxxdm=zkjhk.xxdm
COUNT TO mm FOR bmk.xbm='2' AND bmk.lqxxdm=zkjhk.xxdm
SELECT zkjhk
REPLACE zkjhk.lqrs WITH nn,zkjhk.pjf WITH sn/nn
REPLACE zkjhk.nsrs WITH mm,zkjhk.nsbl WITH mm/nn*100 &&计算女生比例
ENDSCAN
*SELECT bmk
*GO top
*BROWSE &&查看测试用
SELECT zkjhk
GO TOP
BROWSE &&查看测试用
新建文件夹 (2).rar