Страницы: 1
RSS
Дополнить макрос, чтобы преобразования можно было проводить для любого столбца (Inputbox)
 
Здраствуйте! Помогите, пожалуйста, доработать макрос, необходимо чтобы через функцию Inputbox преобразования можно было проводить для любого столбца, представление имею как это сделать, но не получается.
И отдельно необходимо сделать макрос который сразу будет полностью обрабатывать таблицу.
Спасибо.
 
Попробуйте так

Код
Sub ГруппированнаяВыборка()

Dim k As Integer
i = 1
s = Abs(Val(InputBox("Введите номер столбца")))
If s < 1 Then Exit Sub

Do While Not IsEmpty(Cells(i, CInt(s)))
    i = i + 1
Loop


n = i - 1
xmin = Cells(1, CInt(s))
xmax = Cells(1, CInt(s))
For i = 1 To n
If xmin > Cells(i, CInt(s)) Then xmin = Cells(i, CInt(s))
If xmax < Cells(i, CInt(s)) Then xmax = Cells(i, CInt(s))
Next i

k = Int(1 + 3.32 * Log(n) / Log(10))
R = xmax - xmin
h = Round(R / k, 2)
Cells(2, 13) = "№"
Cells(2, 14) = "левая граница"
Cells(2, 15) = "правая граница"
Cells(2, 16) = "среднее значение"
Cells(2, 17) = "частота"

For i = 1 To k
    Cells(i + 2, 13) = i
    Cells(i + 2, 14) = xmin + (i - 1) * h
    Cells(i + 2, 15) = xmin + i * h
    Cells(i + 2, 16) = (Cells(i + 2, 14) + Cells(i + 2, 15)) / 2

    n1 = 0
    For j = 1 To n
        If Cells(j, CInt(s)) >= Cells(i + 2, 14) And Cells(j, CInt(s)) <= Cells(i + 2, 15) Then n1 = n1 + 1
    Next j
    Cells(i + 2, 17) = n1
Next i

End Sub
Изменено: Msi2102 - 09.12.2021 09:20:06
 
Спасибо большое, все работает.
А не подскажите, как будет выглядеть макрос для преобразования всей таблицы?
 
Алина Стахович, Исправил код, проверьте ещё раз
 
Цитата
Алина Стахович написал:
для преобразования всей таблицы
Попробуйте так, не даю гарантий, что правильно, нужно проверять
Код
Sub ГруппированнаяВыборка_1()
Dim c As Range

Dim k As Integer
i = 1
s = Abs(Val(InputBox("Введите номер столбца")))
If s < 1 Then Exit Sub

Do While Not IsEmpty(Cells(i, CInt(s)))
    i = i + 1
Loop


n = i - 1
xmin = Cells(1, 1)
xmax = Cells(1, 1)

For Each c In Range(Cells(1, 1), Cells(n, CInt(s)))

If xmin > c Then xmin = c
If xmax < c Then xmax = c
Next c

k = Int(1 + 3.32 * Log(n) / Log(10))
R = xmax - xmin
h = Round(R / k, 2)
Cells(2, 13) = "№"
Cells(2, 14) = "левая граница"
Cells(2, 15) = "правая граница"
Cells(2, 16) = "среднее значение"
Cells(2, 17) = "частота"

For i = 1 To k
    Cells(i + 2, 13) = i
    Cells(i + 2, 14) = xmin + (i - 1) * h
    Cells(i + 2, 15) = xmin + i * h
    Cells(i + 2, 16) = (Cells(i + 2, 14) + Cells(i + 2, 15)) / 2

    n1 = 0
    For Each c In Range(Cells(1, 1), Cells(n, CInt(s)))
        If c >= Cells(i + 2, 14) And c <= Cells(i + 2, 15) Then n1 = n1 + 1
    Next c
    Cells(i + 2, 17) = n1
Next i

End Sub


Нужно ввести номер последнего столбца
Изменено: Msi2102 - 09.12.2021 09:21:05
 
Цитата
Msi2102 написал:
s = InputBox("Введите номер столбца")
If Not IsNumeric(s) Then Exit Sub
Если указать 0 или отрицательное число - то выхода не будет и код пойдет дальше и в итоге получим ошибку.
Думаю, лучше так:
Код
    Dim lcol&
    lcol = Abs(Val(InputBox("Введите номер столбца")))
    If lcol < 1 Then Exit Sub
Даже самый простой вопрос можно превратить в огромную проблему. Достаточно не уметь формулировать вопросы...
 
Цитата
Дмитрий(The_Prist) Щербаков написал:
Если указать 0 или отрицательное число
Согласен мой косяк, сейчас исправлю Исправил
Изменено: Msi2102 - 09.12.2021 09:21:28
 
Спасибо
Страницы: 1
Наверх