锦到说VBA

VBA——选中所有优秀科目并汇总到同一工作簿下的另一个工作表

问题：选中一个专业的同学前五个学期，所有优秀科目（得分>=90)，并把选中的信息汇总到另一个EXCEL工作簿中

问题分析：观察成绩表的布局

可以看出，要统计优秀科目，即是判断总评成绩是否>=90或者是否为"优秀"
要求汇总到另一个工作表，那么可以命名当前工作表为"全班成绩",命名一个新工作表为"汇总"。(当然这里的新表也可以直接在代码中实现，不过我当时没有写这段)

代码如下：

Sub 选中优秀()
Dim i                                                   '定义i为控制行的循环控制变量
Dim k                                                   '定义k为一个循环控制变量
Dim r As Worksheet                                      '定义r为一个worksheet对象
Dim w As Worksheet                                      '定义w为一个worksheet对象
i = 2                                                   '在"全班成绩"中，第一行为表头，数据从第二行开始读取
j = 1                                                   '定义j为控制新表中的循环变量
t = Timer                                               '初始时间

Set r = Worksheets.Add
r.Name = "汇总结果" & t                                 '生成汇总结果工作簿,以时间t为后缀名
Set w = Worksheets("全班成绩")

While w.Cells(i, 9) <> ""                               '总评成绩非空，则执行循环

    If w.Cells(i, 9) >= 90 And w.Cells(i, 9) <= 100 _
        Or w.Cells(i, 9) = "优秀" Then                  '判断标准
        
        w.Cells(i, 9).Interior.Color = RGB(255, 0, 0)   '选中的成绩背景色标红
        w.Cells(i, 3).Interior.Color = RGB(255, 255, 0) '选中成绩对应的科目背景色标黄
        k = 1                                           '整行赋值，k为初始变量
        
        While w.Cells(i, k) <> "电信工程及管理"          '以电管作为每一行的结束
            r.Cells(j, k) = w.Cells(i, k)               '选中的每一条赋值到新表
            k = k + 1
        Wend
        
    j = j + 1                                           '每选中一份数据赋值过去后，新表中行数+1
    Else
    End If
    
i = i + 1                                               '扫源表中下一行数据
Wend                                                    '结束while循环

MsgBox Timer - t                                        '测量程序运行时间并显示
End Sub

演示效果：

总结：

目前来看，大体能满足题目要求，但是仍然存在几个问题：

1. 若需要汇总在新的EXCEL文件中，则要用到application对象，暂时还没进行学习；
2. 还没有学会操作一整行，只是用“电管”作为结束的话代码健壮性不够；
3. 运行时长20秒，有待优化；
4. 汇总工作表是提前建好的，实际上应该在有需要的时候让其自己定义。