Excel

来自tomtalk
Tom讨论 | 贡献2019年6月28日 (五) 09:16的版本 (创建页面,内容为“<source lang="vba"> Sub format() Worksheets(2).Range("A1:G200").ClearFormats End Sub Sub take_out_course() '选出能开课的选修课,生成数组 Di...”)

(差异) ←上一版本 | 最后版本 (差异) | 下一版本→ (差异)
跳转至: 导航搜索

无效的语言。

您需要指定一种语言,像这样: <source lang="html4strict">...</source>

语法高亮所支持的语言:

4cs, 6502acme, 6502kickass, 6502tasm, 68000devpac, abap, actionscript, actionscript3, ada, algol68, apache, applescript, apt_sources, arm, asm, asp, asymptote, autoconf, autohotkey, autoit, avisynth, awk, bascomavr, bash, basic4gl, bf, bibtex, blitzbasic, bnf, boo, c, c_loadrunner, c_mac, caddcl, cadlisp, cfdg, cfm, chaiscript, cil, clojure, cmake, cobol, coffeescript, cpp, cpp-qt, csharp, css, cuesheet, d, dcl, dcpu16, dcs, delphi, diff, div, dos, dot, e, ecmascript, eiffel, email, epc, erlang, euphoria, f1, falcon, fo, fortran, freebasic, freeswitch, fsharp, gambas, gdb, genero, genie, gettext, glsl, gml, gnuplot, go, groovy, gwbasic, haskell, haxe, hicest, hq9plus, html4strict, html5, icon, idl, ini, inno, intercal, io, j, java, java5, javascript, jquery, kixtart, klonec, klonecpp, latex, lb, ldif, lisp, llvm, locobasic, logtalk, lolcode, lotusformulas, lotusscript, lscript, lsl2, lua, m68k, magiksf, make, mapbasic, matlab, mirc, mmix, modula2, modula3, mpasm, mxml, mysql, nagios, netrexx, newlisp, nsis, oberon2, objc, objeck, ocaml, ocaml-brief, octave, oobas, oorexx, oracle11, oracle8, oxygene, oz, parasail, parigp, pascal, pcre, per, perl, perl6, pf, php, php-brief, pic16, pike, pixelbender, pli, plsql, postgresql, povray, powerbuilder, powershell, proftpd, progress, prolog, properties, providex, purebasic, pycon, pys60, python, q, qbasic, rails, rebol, reg, rexx, robots, rpmspec, rsplus, ruby, sas, scala, scheme, scilab, sdlbasic, smalltalk, smarty, spark, sparql, sql, stonescript, systemverilog, tcl, teraterm, text, thinbasic, tsql, typoscript, unicon, upc, urbi, uscript, vala, vb, vbnet, vedit, verilog, vhdl, vim, visualfoxpro, visualprolog, whitespace, whois, winbatch, xbasic, xml, xorg_conf, xpp, yaml, z80, zxbasic


Sub format()
    Worksheets(2).Range("A1:G200").ClearFormats
End Sub
Sub take_out_course()
    '选出能开课的选修课,生成数组
    Dim n As Integer
    n = 0
    Dim course_name_array() As String
    For i = 1 To 100
        course_name = Worksheets(1).Range("A" & i).Value
        course_valid = Worksheets(1).Range("F" & i).Value
       
        If course_name = "" Then
            Exit For
        End If
            
        If course_valid = "是" Then
            'Ctrl+G调出“立即窗口”查看
            Debug.Print course_name
            ReDim Preserve course_name_array(n)
            course_name_array(n) = course_name
            n = n + 1
        End If
    Next i
    
    Debug.Print ""
    
    '复制sheet2第一行标题到sheet3
    Worksheets(3).Cells(1, 1).Value = "姓名"
    Worksheets(3).Cells(1, 2).Value = "第1申报课程"
    Worksheets(3).Cells(1, 3).Value = "第2申报课程"
    Worksheets(3).Cells(1, 4).Value = "第3申报课程"
    
    '遍历每位同学
    row_n = 2
    col_n = 2
    Do While Worksheets(2).Cells(row_n, col_n).Value <> ""
        '复制同学姓名sheet3
        Worksheets(3).Cells(row_n, col_n - 1).Value = Worksheets(2).Cells(row_n, col_n - 1).Value
        row_course_name = ""
        course_name = Worksheets(2).Cells(row_n, col_n).Value
        '遍历申报课程
        hit = 0
        Do While course_name <> ""
            row_course_name = row_course_name & course_name & "    "
            '可申报则标记,否则置灰,3门以上全置灰
            For Each course_name_valid In course_name_array
                If course_name = course_name_valid Then
                   'Worksheets(2).Cells(row_n, col_n).Font.FontStyle = "bold"
                   Worksheets(2).Cells(row_n, col_n).Interior.Color = RGB(0, 176, 240)
                   Worksheets(2).Cells(row_n, col_n).Font.Color = RGB(255, 255, 255)
                   Worksheets(3).Cells(row_n, hit + 2).Value = course_name
                   hit = hit + 1
                End If
                
                If hit >= 3 Then
                  Exit For
                End If
            Next course_name_valid
            
            col_n = col_n + 1
            course_name = Worksheets(2).Cells(row_n, col_n).Value
        Loop
        col_n = 2
                
        'Debug.Print row_course_name
        row_n = row_n + 1
    Loop
End Sub