如何从Excel工作表加载数组至VBA？自定义分数转等级函数报错求解

问题出在这几个地方：

• 用ParamArray接收工作表单元格区域时，拿到的是二维数组（哪怕是单列/单行），原代码按一维数组遍历直接报错。
• IsMissing(Pattern)对ParamArray根本没用，因为ParamArray就算没传参数，也是个长度为0的数组，永远不会触发Missing状态。
• 原代码硬编码了Grades数组，用户自定义Pattern时，等级和分数阈值的数量很可能不匹配，逻辑直接乱掉。

下面是修复后的完整代码：

Function GRADE(Points As Variant, ParamArray PatternAndGrades()) As Variant
    ' 预设默认的分数阈值和对应等级
    Dim defaultPattern As Variant
    Dim defaultGrades As Variant
    defaultPattern = Array(90.5, 80, 75, 70, 65, 60, 55, 50, 45, 40, 35)
    defaultGrades = Array(1, 1.3, 1.7, 2, 2.3, 2.7, 3, 3.3, 3.7, 4, 5)
    
    Dim patternArr As Variant
    Dim gradeArr As Variant
    
    ' 处理参数逻辑
    If UBound(PatternAndGrades) = -1 Then
        ' 没传自定义参数，用预设值
        patternArr = defaultPattern
        gradeArr = defaultGrades
    ElseIf UBound(PatternAndGrades) = 0 Then
        ' 只传了分数阈值，提示补传等级
        GRADE = "请同时传入分数阈值和对应等级"
        Exit Function
    Else
        ' 把工作表区域的二维数组转成一维，方便遍历
        patternArr = FlattenArray(PatternAndGrades(0))
        gradeArr = FlattenArray(PatternAndGrades(1))
        
        ' 检查两组数据数量是否一致
        If UBound(patternArr) <> UBound(gradeArr) Then
            GRADE = "分数阈值和等级数量不匹配"
            Exit Function
        End If
    End If
    
    ' 匹配对应的等级
    Dim i As Integer
    For i = LBound(patternArr) To UBound(patternArr)
        If Points >= patternArr(i) Then
            GRADE = gradeArr(i)
            Exit Function
        End If
    Next i
    
    ' 分数低于所有阈值时，返回最低等级
    GRADE = gradeArr(UBound(gradeArr))
End Function

' 辅助函数：把二维数组（或工作表区域）转成一维数组
Function FlattenArray(arr As Variant) As Variant
    Dim flattened As Variant
    Dim i As Integer, j As Integer
    Dim count As Integer
    
    ' 如果传入的是单元格区域，先转成数组
    If TypeName(arr) = "Range" Then
        arr = arr.Value
    End If
    
    ' 判断是否为二维数组，是的话就拆成一维
    If UBound(arr, 2) > 1 Or LBound(arr, 2) < 1 Then
        count = 0
        ReDim flattened(1 To UBound(arr, 1) * UBound(arr, 2))
        For i = LBound(arr, 1) To UBound(arr, 1)
            For j = LBound(arr, 2) To UBound(arr, 2)
                count = count + 1
                flattened(count) = arr(i, j)
            Next j
        Next i
        ReDim Preserve flattened(1 To count)
    Else
        ' 本身就是一维数组，直接返回
        flattened = arr
    End If
    
    FlattenArray = flattened
End Function

使用方法 #

• 默认调用：直接写=GRADE(A1)，用预设的分数-等级规则。
• 自定义规则：写=GRADE(A1, B1:B11, C1:C11)，其中B列是从高到低排的分数阈值，C列是对应的等级。

关键修复点 #

• 加了FlattenArray辅助函数，自动处理工作表区域转一维数组的问题，不用手动转格式。
• 把参数改成同时接收分数阈值和等级数组，避免硬编码导致的匹配错误。
• 修正了无参数时的判断逻辑，原来的IsMissing完全没用，现在用UBound判断数组长度。
• 加了参数校验，避免用户只传一组数据或者两组数据数量不匹配的情况。

内容的提问来源于stack exchange，提问作者Marvin J.