VBA实现二维数组最小值查找自定义函数的传参问题求解

原有代码问题 #

改写代码运行异常主要由4个问题导致：

• 数组类型不匹配：定义的temp是Integer类型二维数组，但Function形参声明为Variant类型数组，VBA不支持强类型数组隐式转换为Variant类型数组直接传参
• 数组遍历逻辑错误：Function内完全按一维数组逻辑取值，没有处理二维数组的第二维度，同时For/Next循环嵌套错位，行遍历循环没有对应的闭合语句
• 最值判断逻辑写反：判断条件用了>=，实际是取最大值的逻辑，和查找最低温的需求相反
• 初始化位置错误：把最小值变量的初始化放在行遍历循环内部，每次遍历行都会重置最小值，计算结果完全错误

修正后完整代码 #

Sub test()
    Dim i As Integer, j As Integer
    Dim temp(30, 3) As Integer
    Dim minTempResult As Variant
    
    ' 读取B2:E30区域的温度数据存入二维数组
    For i = 2 To 30
        For j = 2 To 5
            temp(i - 2, j - 2) = Cells(i, j).Value
        Next j
    Next i
    
    ' 调用自定义函数获取4个地点的最低温
    minTempResult = LowestTemp(temp)
    
    ' 和原逻辑一致，将结果写入第33行B到E列
    For j = 0 To 3
        Cells(33, j + 2).Value = minTempResult(j)
    Next j
End Sub

' 自定义最低温计算函数，接收Integer类型二维数组，返回每列最小值组成的一维数组
Function LowestTemp(tArr() As Integer) As Variant
    Dim rowLbound As Integer, rowUbound As Integer
    Dim colLbound As Integer, colUbound As Integer
    Dim minVals() As Integer
    Dim i As Integer, j As Integer
    
    ' 动态获取数组边界，无需硬编码维度值
    rowLbound = LBound(tArr, 1)
    rowUbound = UBound(tArr, 1)
    colLbound = LBound(tArr, 2)
    colUbound = UBound(tArr, 2)
    ReDim minVals(colLbound To colUbound)
    
    ' 按列遍历（每个地点对应一列）
    For j = colLbound To colUbound
        ' 初始化当前列最小值为列首行数值
        minVals(j) = tArr(rowLbound, j)
        ' 遍历列内所有行更新最小值
        For i = rowLbound + 1 To rowUbound
            If tArr(i, j) < minVals(j) Then
                minVals(j) = tArr(i, j)
            End If
        Next i
    Next j
    
    LowestTemp = minVals
End Function

关键说明 #

• 如果需要让函数兼容更多数值类型（比如Single、Double类型的温度值），可以把test过程里的temp数组定义为Variant类型，同时把Function的入参改为tArr As Variant即可，不需要加括号限制为数组类型，Variant可以直接接收数组
• 二维数组取值必须写两个索引，格式为数组名(行索引, 列索引)，取数组边界时第二个参数指定维度，1代表第一维度（行）、2代表第二维度（列）
• 硬编码数组上下界的写法兼容性差，用LBound/UBound动态获取边界可以适配不同大小的数据源，不需要每次修改代码里的固定数值

内容的提问来源于stack exchange，提问作者npm