

VBA编程——快速生成三好、合格奖励学生名单

科技码源

2024-05-01

导读：中期教学质量监测过后，都会对一些表现突出的优秀学生进行表彰奖励。对于一些学生人数较多的县城学校，一个年级的一次奖励，授奖人次多达几百，尤其是三好学生、合格生人数最多，统计起来费时费力。

学生学业水平评价数据

中期教学质量监测过后，都会对一些表现突出的优秀学生进行表彰奖励。对于一些学生人数较多的县城学校，一个年级的一次奖励，授奖人次多达几百，尤其是三好学生、合格生人数最多，统计起来费时费力。

以前，总是用Excel的中函数来挑选三好、合格学生的。然而写函数，由于有时涉及的参数和括号较多，一个函数语句通常要写多遍才能写正确。况且这次统计完毕后，等到下次使用时，因为科目的变化等因素，又要重新编写函数。有时想着找到以前统计了的表格来复制公式，但由于时间跨度大，表格存储的名称和位置都不能被准确回忆。

还是用VBA编写个小程序来统计三好、合格学生吧！

VBA编程界面

成功统计后的效果图

通过上图可以看出，三好学生、合格学生均已按班级统计到了Excel的两列，后续就直接可以用Word中的邮件合并来打印奖状了。

现将快速生成三好、合格奖励学生名单的VBA源代码作以分享！

快速生成三好、合格奖励学生名单VBA代码

Sub CheckStu()    Dim PassStu(1000, 20) As String    Dim BestStu(1000, 20) As String    Erase PassStu    Erase BestStu    Dim rng As Range    For Each rng In Sheets("年级数据").UsedRange        If rng.Value = "班级" Then            Class_row = rng.Row            Class_col = rng.Column        End If        If rng.Value = "姓名" Then            Name_row = rng.Row            Name_col = rng.Column        End If        If rng.Value = "语文" Then            Chinese_row = rng.Row            Chinese_col = rng.Column        End If        If rng.Value = "总分" Then            Totle_row = rng.Row            Totle_col = rng.Column        End If    Next    i = Chinese_row + 1    j = Chinese_col    m = 0    n = 0    Do While Sheets("年级数据").Cells(i, j - 1) <> ""        PassSub = 0        BestSub = 0        For k = j To Totle_col - 1            If Sheets("年级数据").Cells(i, k) >= 80 Then BestSub = BestSub + 1        Next        If BestSub = Totle_col - j Then            n = n + 1            BestStu(n, 1) = Sheets("年级数据").Cells(i, Class_col)            BestStu(n, 2) = Sheets("年级数据").Cells(i, Name_col)        End If        For k = j To Totle_col - 1            If Sheets("年级数据").Cells(i, k) >= 60 Then PassSub = PassSub + 1        Next        If PassSub = Totle_col - j And PassSub <> BestSub Then            m = m + 1            PassStu(m, 1) = Sheets("年级数据").Cells(i, Class_col)            PassStu(m, 2) = Sheets("年级数据").Cells(i, Name_col)        End If                i = i + 1    Loop    p = 2    q = 2        For b = 1 To 20        For a = 1 To m            If CnToNumber(PassStu(a, 1)) = b Then                Sheets("三好合格生").Cells(p, 3) = b                Sheets("三好合格生").Cells(p, 4) = PassStu(a, 2)                p = p + 1            End If        Next    Next        For b = 1 To 20        For a = 1 To n            If CnToNumber(BestStu(a, 1)) = b Then                Sheets("三好合格生").Cells(q, 1) = b                Sheets("三好合格生").Cells(q, 2) = BestStu(a, 2)                q = q + 1            End If        Next    Next    With Sheets("三好合格生").Range(Cells(2, 1), Cells(m, 4))        .Font.Name = "宋体"        .Font.Size = 10        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter    End WithEnd Sub

清除数据操作VBA代码

Sub ClearDate()    Sheets("三好合格生").Cells.ClearContents    Sheets("三好合格生").Cells(1, 3) = "班级"    Sheets("三好合格生").Cells(1, 4) = "学习之星"    Sheets("三好合格生").Cells(1, 1) = "班级"    Sheets("三好合格生").Cells(1, 2) = "三好学生"    With Sheets("三好合格生").Range(Cells(1, 1), Cells(1, 4))        .Font.Name = "黑体"        .Font.Size = 10        .HorizontalAlignment = xlCenter        .VerticalAlignment = xlCenter    End WithEnd Sub