【原】VBA【代码】成绩等级划分：自定义函数；类模块、集合的运用

内容提要

• 成绩等级划分|完整代码

1、在类模块SubjectGrade里，定义三个变量：

Public SubjectName As String  '//科目名称Public GradeName As String    '//等级名称Public MinimumScore As Single '//等级分下限

2、在myModule里，addGrades、AddGrade过程，把科目名称、等级名称、等级分数添加到集合：

Sub addGrades()    '//把各科目的最低等级分按顺序添加到集合 '，标准发生了改变的，就在这修改    Set collGrade = New Collection        '//语文    AddGrade "语文", "优秀", 96:    AddGrade "语文", "良好", 84    AddGrade "语文", "合格", 72:    AddGrade "语文", "待合格", 0        '//数学    AddGrade "数学", "优秀", 96:    AddGrade "数学", "良好", 84    AddGrade "数学", "合格", 72:     AddGrade "数学", "待合格", 0        '//英语    AddGrade "英语", "优秀", 96:    AddGrade "英语", "良好", 84    AddGrade "英语", "合格", 72:    AddGrade "英语", "待合格", 0        '//道德与法治    AddGrade "道德与法治", "优秀", 80:    AddGrade "道德与法治", "良好", 70    AddGrade "道德与法治", "合格", 60:    AddGrade "道德与法治", "待合格", 0        '//历史    AddGrade "历史", "优秀", 80:     AddGrade "历史", "良好", 70    AddGrade "历史", "合格", 60:     AddGrade "历史", "待合格", 0        '//地理    AddGrade "地理", "优秀", 80:    AddGrade "地理", "良好", 70    AddGrade "地理", "合格", 60:    AddGrade "地理", "待合格", 0        '//生物    AddGrade "生物", "优秀", 80:     AddGrade "生物", "良好", 70    AddGrade "生物", "合格", 60:    AddGrade "生物", "待合格", 0        '//物理    AddGrade "物理", "优秀", 80:    AddGrade "物理", "良好", 70    AddGrade "物理", "合格", 60:    AddGrade "物理", "待合格", 0        '//总分    AddGrade "总分", "优秀", 688:    AddGrade "总分", "良好", 602    AddGrade "总分", "合格", 516:    AddGrade "总分", "待合格", 0End SubPrivate Sub AddGrade(subj As String, grade As String, minScore As Single)    Dim clsSG As New SubjectGrade    With clsSG        .SubjectName = subj        .GradeName = grade        .MinimumScore = minScore    End With    collGrade.Add clsSGEnd Sub

3、在myModule里，自定义函数getGrade，根据科目名称、分数，得出相应等级；函数IsCollectionEmpty，判断集合是否为空：

Function getGrade(ByVal subject As String, ByVal score As Single) As String    Dim grade As SubjectGrade    Dim result As String    If IsCollectionEmpty(collGrade) Then        Call addGrades    End If    result = "未知"    For Each grade In collGrade        If grade.SubjectName = subject And score >= grade.MinimumScore Then            result = grade.GradeName            Exit For        End If    Next    getGrade = resultEnd Function
Private Function IsCollectionEmpty(col As Collection) As Boolean    On Error Resume Next    Dim obj As Object    Set obj = col(1)    If Err.Number <> 0 Then        IsCollectionEmpty = True    Else        IsCollectionEmpty = False    End If    On Error GoTo 0End Function

~~~~~~End~~~~~~