Создание функции в Excel VBA для вычисления средней точки в круговом наборе чисел

Question

Все еще довольно любитель, так что будьте осторожны. Я пытаюсь создать функцию, которая дает среднее значение набора чисел. Набор чисел на самом деле является зубцом винтика. Первым зубом всегда является зуб 1 (идентифицируемый как окрашенный), повреждение или закупорка регистрируются на зубах при вращении по часовой стрелке, поэтому повреждение на зубах 7 и 23 будет на зубах 7 и 23 от исходного зуба. Аномалия возникает, когда вы вычисляете нормальное среднее значение, поскольку среднее количество остановок на зубах 3, 4 и 33 фактически будет 1, а НЕ 14,33 в соответствии со стандартным средним. Я рассчитал это, чтобы найти среднее значение, и под средним я подразумеваю более близкое к медиане набора круговых чисел. Я добавляю по единице к каждому значению в диапазоне и вычисляю разницу между максимальным и минимальным числами, используя функцию MOD. Как только я определяю первую позицию самой короткой разницы, это просто случай вычитания увеличенного значения из нового среднего. Это, наверное, лучше описать в таблице ...

введите описание изображения здесь

Как видите, реальное среднее значение или медиана - это зубец 1, который является средним минус приращение первого набора чисел с наименьшей разницей. Код, который у меня есть в настоящее время для go посредством выполнения этих вычислений, дает значение # error, но мой опыт работы с пользовательскими функциями очень минимален, и я не знаю, с чего начать исправление проблемы, указатели будут оценены, решение будет fantasti c. Заранее большое спасибо.

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

Answer 1

Спасибо BigBen за помощь в использовании массива. Чтобы вычислить среднее значение кругового набора чисел, я использовал приведенный ниже код. Надеюсь, этот пример поможет кому-нибудь еще с подобными проблемами. Если вам нужно другое количество зубцов, просто измените значение MOD соответствующим образом.

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

Answer 2

Как насчет этого? Кажется, возвращает то же значение, что и в вашем примере, но было бы полезно иметь больше расчетов для проверки ...

Function AvgDistance(vals As Range, teeth) As Double
    Dim arr, i As Long, tot As Long, v
    arr = vals.Value
    tot = 0
    For i = 1 To UBound(arr, 1)
        v = arr(i, 1)
        tot = tot + IIf(v > (teeth / 2), v - teeth, v)
    Next i
    AvgDistance = tot / UBound(arr, 1)
End Function