Загрузка данных


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