excel - Creating a function in excel VBA to calculate the average point in a circular set of numbers

Question

Still fairly amateur at this so please be gentle. I am trying to create a function that gives the average of a set of numbers. The set of numbers are actually the teeth of a cog. The primary tooth is always tooth 1 (identifiable as painted), damage or stoppage is recorded on teeth in a clockwise rotation so damage at teeth 7 and 23 would be at 7 and 23 teeth from the starting tooth. Now an anomaly occurs when you calculate a normal average as the average of stoppages at teeth 3, 4 and 33 would infact be 1 NOT 14.33 as per a standard average. I have calculated that to find the average, and by average I mean more nearer the median of a set of circular numbers. I add one to each value in the range and calculate the difference between the maximum and minimum numbers using the MOD function. Once I identify the first position of the shortest difference it is simply a case of subtracting the incremented value from the new average. It probably is better described in a table...

As you can see, the real average or median is tooth 1, which is the average minus the increment of the first number set with the smallest difference. The code I have at present to go through an do these calculations is giving a value# error but my experience with custom functions is very minimal and I don't know where to start in correcting the issue, pointers would be appreciated, a solution would be fantastic. Many thanks in advance.

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
    
    AVGDISTCALC = avg - x
    
End Function

标签： excelvbaaveragecustom-function

Answer 1

Thanks to BigBen for the steer onto using an array. To calculate the average of a circular set of numbers I used the code below. I hope this example helps anyone else with similar issues. If you need a different number of cog teeth you should just change the MOD value appropriately.

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