锦到说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. 汇总工作表是提前建好的,实际上应该在有需要的时候让其自己定义。

你可能感兴趣的:(锦到说VBA)