excel 将自定义范围函数更改为自定义数组函数

lokaqttq  于 2023-03-13  发布在  其他
关注(0)|答案(1)|浏览(157)

我创建了下面的函数来计算37齿车轮的平均行驶距离,我对它很满意,它工作得很好,但它是在一个范围内计算的,所以这意味着我必须将数字放入一个设定的范围内,并从那里计算出来。

Public Function AVGDISTCALC(rng As Range)
'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 arr() As Variant
Dim R As Long
Dim c As Long
Application.ScreenUpdating = False

    'Write the range to an array.
    arr = rng
    'Cycle through each increment on the 37 tooth wheel.
    diff = 38
    For i = 1 To 37
    arr = rng
        'For each increment calculate the min and max of the range.
        For R = 1 To UBound(arr, 1)
            For c = 1 To UBound(arr, 2)
                If (arr(R, c) + i) Mod 37 = 0 Then
                    arr(R, c) = 37
                Else
                    arr(R, c) = (arr(R, c) + i) Mod 37
                End If
            Next c
        Next R
        If WorksheetFunction.Max(arr) - WorksheetFunction.Min(arr) < diff Then
            diff = WorksheetFunction.Max(arr) - WorksheetFunction.Min(arr)
            avg = WorksheetFunction.Average(arr)
            x = i
        End If
    Next i
    
    Select Case avg - x
    Case 0
        AVGDISTCALC = 37
    Case Is > 0
        AVGDISTCALC = avg - x
    Case Is < 0
        AVGDISTCALC = (avg - x) + 37
    End Select
    
End Function

写入范围会占用内存,而且显然会消耗速度,所以我想我应该更改函数以接受数组......现在我愚蠢地认为这只是使用Paramarray设置新变量的情况,但这并不是因为它总是出现错误,所以我尝试了一些新的东西。我忘了现在是什么。我只是愚蠢或错过了什么,我只是认为它会工作就像范围功能。请帮助。提前感谢你们所有人。

Public Function AVGDISTCALCarr(ParamArray arr1() 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
Application.ScreenUpdating = False

    'Cycle through each increment on the 37 tooth wheel.
    diff = 38
    For i = 1 To 37
        'For each increment calculate the min and max of the range.
        For R = 1 To UBound(arr1, 1)
            For c = 1 To UBound(arr1, 2)
                If (arr1(R, c) + i) Mod 37 = 0 Then
                    arr1(R, c) = 37
                Else
                    arr1(R, c) = (arr1(R, c) + i) Mod 37
                End If
            Next c
        Next R
        If WorksheetFunction.Max(arr1) - WorksheetFunction.Min(arr1) < diff Then
            diff = WorksheetFunction.Max(arr1) - WorksheetFunction.Min(arr1)
            avg = WorksheetFunction.Average(arr1)
            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

我正在运行一个宏,它在轮齿上产生各种距离。然后我把这些写入工作表,这样我就可以执行函数(范围版本)。然后我计算这个平均距离,并继续运行宏。所以我试图删除写入工作表的操作,并将其作为一个数组来计算。下面是我创建的数组类型的示例...

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)

End Sub

但是,我要么得到维数错误,要么它不喜欢AVGDISTCALCarr(Closearr)中的参数,我不明白,我肯定只是把数组名放进去了吗?希望这能解释得更好。

ddrv8njm

ddrv8njm1#

将数组传递给过程

调用过程

Sub MultiSector()

    Dim CloseArr(): CloseArr = Array( _
        11, 22, 33, _
        44, 55, 66) ' add as many as necessary
    Dim CloseAverage As Long: CloseAverage = GetAvgDistance(CloseArr)

End Sub

功能

Function GetAvgDistance(ByVal Arr As Variant) As Long
'Determines the average distance of a number of distances on a 37 tooth wheel.
    
    ' Declare whole number variables as Long, decimals as Double,
    ' and arrays as Variant.
    ' Your data is far too small to complicate things.

    Dim x As Long, i As Long, r As Long,avg As Long, diff As Long
    
    'Cycle through each increment on the 37-tooth wheel.
    diff = 38
    For i = 1 To 37
        'For each increment calculate the min and max of the range.
        For r = LBound(Arr) To UBound(Arr) ' 1D
            If (Arr(r) + i) Mod 37 = 0 Then
                Arr(r) = 37
            Else
                Arr(r) = (Arr(r) + i) Mod 37
            End If
        Next r
        ' Introduce the With statement to make it more readable.
        With WorksheetFunction
            If .Max(Arr) - .Min(Arr) < diff Then
                diff = .Max(Arr) - .Min(Arr)
                avg = .Average(Arr)
                x = i
            End If
        End With
    Next i
    
    Select Case avg - x
        Case 0: GetAvgDistance = 37
        Case Is > 0: GetAvgDistance = avg - x
        Case Is < 0: GetAvgDistance = avg - x + 37
    End Select
    
End Function

相关问题