Excel

第一个vba程序

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