将自定义Range函数转换为自定义Array函数的问题求助

核心问题排查 #

你遇到的维度错误和参数识别问题，根源在于以下几点：

1. ParamArray的结构特性：当传入一个一维数组时，ParamArray arr1()会把这个数组包装成一个一维变体数组（即arr1(0)才是你传入的Closearr），直接用UBound(arr1,2)会触发维度错误，因为arr1本身只有一维。
2. 数组未重置：原Range版本每次循环都会重新从Range读取数组重置数据，但数组版本直接修改传入的数组，导致后续循环使用的是已修改后的数据，逻辑完全错误。
3. 数组维度兼容问题：Range转成的数组默认是二维数组（即使是单列/单行），但你传入的是一维数组，原代码的嵌套循环只适配二维结构。

修正后的AVGDISTCALCarr函数 #

Public Function AVGDISTCALCarr(ParamArray inputArgs() As Variant)
'Determines the average distance of a number of distances on a 37 tooth wheel.
Dim x As Integer
Dim i As Integer
Dim avg As Integer
Dim diff As Integer
Dim R As Long
Dim c As Long
Dim arr() As Variant
Dim tempArr() As Variant

    ' 处理ParamArray参数，提取实际数据源数组
    If UBound(inputArgs) = 0 Then
        arr = inputArgs(0)
    Else
        ' 如果传入多个参数，合并为二维数组（可选逻辑，根据使用场景调整）
        ReDim arr(1 To UBound(inputArgs) + 1, 1 To 1)
        For R = 1 To UBound(arr, 1)
            arr(R, 1) = inputArgs(R - 1)
        Next R
    End If

    ' 统一转换为二维数组（兼容一维输入）
    On Error Resume Next
    Dim tempUBound As Long
    tempUBound = UBound(arr, 2)
    On Error GoTo 0
    If tempUBound = 0 Then
        ReDim tempArr(1 To UBound(arr), 1 To 1)
        For R = 1 To UBound(arr)
            tempArr(R, 1) = arr(R)
        Next R
        arr = tempArr
    End If

    diff = 38
    For i = 1 To 37
        ' 每次循环创建数组副本，避免修改原始数据
        tempArr = arr
        ' 遍历数组元素计算模值
        For R = 1 To UBound(tempArr, 1)
            For c = 1 To UBound(tempArr, 2)
                If (tempArr(R, c) + i) Mod 37 = 0 Then
                    tempArr(R, c) = 37
                Else
                    tempArr(R, c) = (tempArr(R, c) + i) Mod 37
                End If
            Next c
        Next R
        ' 更新最小差值和对应平均值
        Dim currentMax As Integer, currentMin As Integer
        currentMax = WorksheetFunction.Max(tempArr)
        currentMin = WorksheetFunction.Min(tempArr)
        If currentMax - currentMin < diff Then
            diff = currentMax - currentMin
            avg = WorksheetFunction.Average(tempArr)
            x = i
        End If
    Next i
    
    ' 计算最终结果
    Select Case avg - x
    Case 0
        AVGDISTCALCarr = 37
    Case Is > 0
        AVGDISTCALCarr = avg - x
    Case Is < 0
        AVGDISTCALCarr = (avg - x) + 37
    End Select
    
End Function

关键修改说明 #

• ParamArray参数处理：先提取传入的实际数组，支持直接传入一维数组，也支持传入多个单个值（如AVGDISTCALCarr(11,22,33)）。
• 数组维度统一：通过错误捕获判断数组维度，将一维数组自动转换为二维数组，确保后续循环逻辑和原Range版本一致。
• 数组副本机制：每次循环创建数组副本tempArr，避免修改原始输入数组，同时还原了原Range版本每次重置数据的逻辑。
• 移除无效设置：删除Application.ScreenUpdating = False，因为Excel在计算UDF时会自动抑制屏幕更新，该设置无意义。

测试调用代码 #

你的MultiSector宏可以直接使用，无需修改：

Sub MultiSector()
    Dim Closearr(1 To 3) As Integer
    Dim Closeaverage As Integer

    Closearr(1) = 11
    Closearr(2) = 22
    Closearr(3) = 33
    Closeaverage = AVGDISTCALCarr(Closearr)
    ' 添加输出查看结果
    MsgBox "平均距离：" & Closeaverage
End Sub

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