У меня есть распределение чисел порядка 600 тыс. Значений, которое будет выглядеть так:
1, 500, 94, 65, 37, 1000, 1505 и т. Д.
Числа могут повторяться. Я хочу удалить выбросы сверху, потому что концентрация чисел будет около 10, а выбросы искажают мои данные (т. Е. Распределение чисел, которые меня интересуют, начинается с 1 и может варьироваться до 25).
Сначала я беру этот список и сортирую его в порядке возрастания:
1, 1, 1, 1, 1, 2, 2, 2, 2, 2, 2, 2, 3, 3, 3, 3, 3 до, возможно, 1500, 1505, 1600, 1666 и т. Д.
Затем я перехожу к наибольшему значению в списке, начинаю снимать точки и вычисляю среднее и стандартное отклонение при каждом удалении. Я останавливаюсь, когда распределение ниже этой точки становится как можно более нормальным. На данный момент я использую точку остановки stdev / Среднее = 0,4. Я мог бы использовать другие параметры (медиана, мода, среднее), но на данный момент это вспомогательное для обсуждения, которое я хотел бы иметь.
Чтобы сделать это, я сначала попытался удалить точки 1 за один раз и пересчитал среднее значение и stdev, остановившись, когда мой заданный параметр был достигнут. Это занимает слишком много времени. Поэтому я решил сократить количество вычислений. Я сделал это, только рассчитав среднее значение и значение stdev на полпути вверх или вниз по списку и переместившись вверх или вниз в зависимости от значения моего параметра (т.е. stdev / ave <0,4 переместился на полпути вверх от этой точки, stdev / ave> 0,4 переместился на полпути вниз от этой точки). Затем я удаляю все из списка с более высоким измерением, как только критическая точка в моем параметре была достигнута (то есть точка в списке, где stdev / ave опустилась ниже 0,4).
У меня вопрос: есть ли у кого-нибудь предложения о том, как заставить эту штуку работать быстрее? Может быть, сохранить список в виде массива? Или просто продолжать работать со списком? Есть ли другой объект, с которым я могу работать в vba, например, связанный список, может быть, он может работать быстрее? Вот мой код:
Option Explicit
Sub RemoveHighOutliers()
Application.ScreenUpdating = False
Dim i As Double 'iterator for list position
Dim j As Double '0.5 multiplier
Dim cv As Double 'critical value
Dim std As Double 'critical value 2
Dim numRows As Double
numRows = CountRows 'separate module to count the number of rows containing data
i = numRows - 1 'my first set point is the second to last and last values in the list
j = Round(i* 0.5, 0) 'used to move 1/2 way up or down the remainder of the list
cv = WorksheetFunction.stdev(Range("F1:F" & i)) / WorksheetFunction.average(Range("F1:F" & i)) ‘critcal value
If cv < 0.4 Then
GoTo jump1 'if list is already at a point at or below normal distribution don't enter loop
Else
Do
If j < 1 Then 'if j less than 1 causes an infinite loop, at this point, one point down will be critical value to exit loop
i = i - 1
ElseIf WorksheetFunction.stdev(Range("F1:F" & i)) / WorksheetFunction.average(Range("F1:F" & i)) > 0.4 And WorksheetFunction.stdev(Range("F1:F" & i + 1)) / WorksheetFunction.average(Range("F1:F" & i + 1)) > 0.4 Then
i = Round(i - (i * (j / i)), 0) 'if too high in the list move down 1/2 way
ElseIf WorksheetFunction.stdev(Range("F1:F" & i)) / WorksheetFunction.average(Range("F1:F" & i)) < 0.4 And WorksheetFunction.stdev(Range("F1:F" & i + 1)) / WorksheetFunction.average(Range("F1:F" & i + 1)) < 0.4 Then
i = Round((i + (i * (j / i))), 0) 'if too low in the list move up 1/2 way
End If
j = Round(j * 0.5, 0) 'reduce the 1/2 way iterator
cv = WorksheetFunction.stdev(Range("F1:F" & i)) / WorksheetFunction.average(Range("F1:F" & i)) 'recalculate cv
cv2 = WorksheetFunction.stdev(Range("F1:F" & i + 1)) / WorksheetFunction.average(Range("F1:F" & i + 1)) 'recalculate cv2
Loop Until cv <= 0.4 And cv2 > 0.4 'exit loop when critial value reached
Range("A" & i + 1 & ":H" & numRows).Select
Selection.Delete shift:=xlUp 'delete the outliers
jump1:
End If
Application.ScreenUpdating = True
End Sub
