注册 登录
编程论坛 Excel/VBA论坛

如何根据各班的课程表自动生成任课教师的个人课表(一人一sheet)呢?新手小白,希望大神们赐教

Justinleshi 发布于 2022-09-20 20:30, 1218 次点击
只有本站会员才能查看附件,请 登录
3 回复
#2
厨师王德榜2022-09-21 11:29
已经在VFP版块给你回复了.
#3
sostemp2022-09-26 15:00
回复 2楼 厨师王德榜
VFP代码有吗?
想学习下。
#4
厨师王德榜2022-09-27 10:31
其实知道了算法,用什么语言都能做,还可以用python来做.
这里给出vfp代码,供参考:
程序代码:
DO main1

CREATE CURSOR  grbHz(姓名 c(10) ,节次 c(10) ,星期一 c(20) ,星期二 c(20) ,星期三 c(20) , ;
    星期四 c(20) ,星期五 c(20) ,星期六 c(20) ,星期日 c(20))   

SELECT DISTINCT zb.xm FROM zb  ORDER BY zb.xm INTO CURSOR xmlist
SELECT xmlist
SCAN
    DO Outputpc WITH RTRIM(xmlist.xm)
    SELECT grbHz
    APPEND FROM DBF('grb')
    INSERT INTO grbHz (姓名,节次,星期一,星期二,星期三,星期四,星期五,星期六 ,星期日)  ;
     VALUES ('--------','--------','--------','--------','--------', ;
      '--------','--------','--------','--------')
    REPLACE 姓名 WITH xmlist.xm FOR EMPTY(grbhz.姓名)
    USE IN grb
ENDSCAN
USE IN xmlist

PROCEDURE Outputpc
LPARAMETERS cxm as String
SELECT zb.* FROM zb WHERE zb.xm = cxm ORDER BY dday,jc INTO CURSOR d1
IF RECCOUNT('d1') > 0 THEN
    CREATE CURSOR  grb(节次 c(10) ,星期一 c(20) ,星期二 c(20) ,星期三 c(20) , ;
        星期四 c(20) ,星期五 c(20) ,星期六 c(20) ,星期日 c(20))   
    INSERT INTO grb (节次) VALUES (cxm)
    FOR ii = 1 TO 13
        IF ii = 6 OR ii = 11 THEN
            INSERT blank
        ELSE
        INSERT INTO grb(节次 )    VALUES ;
        (IIF(ii = 1 ,'早读','第' + LTRIM(STR(ii - 1)) +  '节') )   
        ENDIF
    ENDFOR
    SELECT d1
    SCAN
        DO CASE
            CASE dday = 1
            UPDATE grb sEt grb.星期一  = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE  grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
            CASE dday = 2
            UPDATE grb sEt  grb.星期二  = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
            CASE dday = 3
            UPDATE grb sEt  grb.星期三  = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
            CASE dday = 4
            UPDATE grb sEt  grb.星期四  = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
            CASE dday = 5
            UPDATE grb sEt  grb.星期五 = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
            CASE dday = 6
            UPDATE grb sEt  grb.星期六 = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
            CASE dday = 7
            UPDATE grb sEt  grb.星期日 = RTRIM(d1.bj) + '.' +  CHR(10) + d1.km ;
              WHERE grb.节次 = IIF(d1.jc = 1 ,'早读','第' + LTRIM(STR(d1.jc - 1 )) +  '节')
        ENDCASE

    ENDSCAN
    USE IN d1

ENDIF

ENDPROC

PROCEDURE main1
xls1 = 'c:\XIDE\Prg\高二-班级课表(以班级分类)-1页1班.xls'
oExl = CREATEOBJECT('Excel.application')
owb = oExl.Workbooks.Open(xls1)
IF USED('zb') THEN
    USE IN zb
ENDIF
CREATE CURSOR  zb(bj c(10) ,dday i , km c(10) , xm c(10) , jc i )
FOR EACH sht IN owb.worksheets
    WAIT sht.name WINDOW AT 10,20 NOWAIT
    arrReadin = sht.range("B3","H17").value
    FOR irow =1 TO 15
        FOR icol =1 TO 7
            item1 = ALLTRIM(arrReadin[irow,icol])
            IF LEN(item1) > 2
                irb = AT( CHR(10), arrReadin[irow,icol])
                IF irb > 0 THEN
                    INSERT INTO zb(bj  ,dday  , km  , xm  , jc ) ;
                        values(sht.name ,icol , ;
                        LEFT(arrReadin[irow,icol],AT( CHR(10), arrReadin[irow,icol])- 1) , ;
                        SUBSTR(arrReadin[irow,icol],AT( CHR(10), arrReadin[irow,icol]) + 1) ,;
                        irow )
                ENDIF
            ENDIF
        NEXT icol
    NEXT irow
NEXT sht

owb.Close
oExl.Quit
WAIT '采集完毕' WINDOW AT 10,20 NOWAIT  

ENDPROC


最后效果:
只有本站会员才能查看附件,请 登录
1