Sub DistributeIntervals()
Dim i As Integer, r As Integer, c As Integer
Dim v As Double, a As Double, b As Double, s As Double
Dim m As Integer, p(1 To 3) As Integer
Dim k(1 To 3) As Integer, d(1 To 3) As Integer
' Поиск минимума и максимума в H2:H31
a = Cells(2, 8).Value
b = a
For i = 2 To 31
v = Cells(i, 8).Value
If v < a Then a = v
If v > b Then b = v
Next i
' Ширина интервала
s = (b - a) / 3
' Очистка столбцов J, K, L, M от предыдущих данных
Range("J:M").ClearContents
' Заголовки
Cells(1, 10).Value = "Данные"
Cells(1, 11).Value = "Интервал 1"
Cells(1, 12).Value = "Интервал 2"
Cells(1, 13).Value = "Интервал 3"
' Счётчики строк для каждого столбца-приёмника
k(1) = 2
k(2) = 2
k(3) = 2
' Счётчики количества чисел в интервалах
p(1) = 0
p(2) = 0
p(3) = 0
' Проход по исходным числам
r = 2
For i = 2 To 31
v = Cells(i, 8).Value
' Копируем в столбец данных (J)
Cells(r, 10).Value = v
r = r + 1
' Определяем номер интервала (1, 2 или 3)
If v < a + s Then
c = 1
ElseIf v < a + 2 * s Then
c = 2
Else
c = 3
End If
' Записываем число в соответствующий столбец
Cells(k(c), 10 + c).Value = v
k(c) = k(c) + 1
p(c) = p(c) + 1
Next i
' Вывод количества чисел под каждым интервалом
For c = 1 To 3
Cells(k(c), 10 + c).Value = "Кол-во: " & p(c)
Next c
End Sub