Домашняя страница Undo Do New Save Карта сайта Обратная связь Поиск по форуму
МИР MS EXCEL - Гость.xls

Вход

Регистрация

Напомнить пароль

 

= Мир MS Excel/Округление диапазона сгенерированных чисел по условию - Мир MS Excel

Старая форма входа
  • Страница 1 из 1
  • 1
Модератор форума: китин, _Boroda_  
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Округление диапазона сгенерированных чисел по условию (Макросы/Sub)
Округление диапазона сгенерированных чисел по условию
Markovich Дата: Понедельник, 28.12.2020, 22:42 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 50
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Доброго времени суток, уважаемые форумчане! Оптимизирую и по-мере сил ускоряю рабочую табличку. В таблице работает макрос ГСЧ на основе макроса из выполнение двух генераторов СЧ без промежуточных ячеек. Сгенерированные макросом диапазоны чисел далее округляются по условию: если значение ячейки <10, то округление до целого числа, если <100, то кратно 10, во всех остальных случаях кратно 100. Использую формулу для одной ячейки
Код
=ЕСЛИМН(N11<10;ОКРУГЛ(N11;0);N11<1000;ОКРУГЛ(N11;-1);ИСТИНА;ОКРУГЛ(N11;-2))
(для остальных ячеек диапазона аналогично). Вопрос в следующем... Можно ли данную формулу реализовать макросом и соответственно интегрировать в существующий макрос? Самому написать не получается, собственных знаний пока хватило только слегка адаптировать ГСЧ от Kuzmich(а). Во вложении пример с рабочим макросом, как хотелось бы чтобы это работал.
К сообщению приложен файл: 2510575.xls (149.0 Kb)


Сообщение отредактировал Markovich - Понедельник, 28.12.2020, 23:05
 
Ответить
СообщениеДоброго времени суток, уважаемые форумчане! Оптимизирую и по-мере сил ускоряю рабочую табличку. В таблице работает макрос ГСЧ на основе макроса из выполнение двух генераторов СЧ без промежуточных ячеек. Сгенерированные макросом диапазоны чисел далее округляются по условию: если значение ячейки <10, то округление до целого числа, если <100, то кратно 10, во всех остальных случаях кратно 100. Использую формулу для одной ячейки
Код
=ЕСЛИМН(N11<10;ОКРУГЛ(N11;0);N11<1000;ОКРУГЛ(N11;-1);ИСТИНА;ОКРУГЛ(N11;-2))
(для остальных ячеек диапазона аналогично). Вопрос в следующем... Можно ли данную формулу реализовать макросом и соответственно интегрировать в существующий макрос? Самому написать не получается, собственных знаний пока хватило только слегка адаптировать ГСЧ от Kuzmich(а). Во вложении пример с рабочим макросом, как хотелось бы чтобы это работал.
Автор - Markovich
Дата добавления - 28.12.2020 в 22:42
Kuzmich Дата: Понедельник, 28.12.2020, 23:21 | Сообщение № 2
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Цитата
Можно ли данную формулу реализовать макросом

Для диапазона 1 значение ячейки <10, то округление до целого числа,
Для диапазона 2 и 3 значение ячейки >100, то округление кратно 100
Вместо ваших 3-циклов используйте один
[vba]
Код
    For j = 14 To 23
        Randomize
        Cells(i, j) = WorksheetFunction.Round(Int((Cells(i, "D") - Cells(i, "C") + 1) * Rnd + Cells(i, "C")), 0)
        Cells(i, j + 11) = WorksheetFunction.Round(Int((Cells(i, "H") - Cells(i, "G") + 1) * Rnd + Cells(i, "G")), -2)
        Cells(i, j + 22) = WorksheetFunction.Round(Int((Cells(i, "L") - Cells(i, "K") + 1) * Rnd + Cells(i, "K")), -2)
    Next
[/vba]


Сообщение отредактировал Kuzmich - Понедельник, 28.12.2020, 23:33
 
Ответить
Сообщение
Цитата
Можно ли данную формулу реализовать макросом

Для диапазона 1 значение ячейки <10, то округление до целого числа,
Для диапазона 2 и 3 значение ячейки >100, то округление кратно 100
Вместо ваших 3-циклов используйте один
[vba]
Код
    For j = 14 To 23
        Randomize
        Cells(i, j) = WorksheetFunction.Round(Int((Cells(i, "D") - Cells(i, "C") + 1) * Rnd + Cells(i, "C")), 0)
        Cells(i, j + 11) = WorksheetFunction.Round(Int((Cells(i, "H") - Cells(i, "G") + 1) * Rnd + Cells(i, "G")), -2)
        Cells(i, j + 22) = WorksheetFunction.Round(Int((Cells(i, "L") - Cells(i, "K") + 1) * Rnd + Cells(i, "K")), -2)
    Next
[/vba]
Автор - Kuzmich
Дата добавления - 28.12.2020 в 23:21
Markovich Дата: Вторник, 29.12.2020, 07:54 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 50
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Kuzmich, большое спасибо за помощь! Но решение немного неверное: изначально, в диапазонах для генератора 1 (ячейки C5 - H5) числа могут быть абсолютно разные, например, в диапазоне 1 3000-15000, в диапазоне 2 50-300, в диапазоне 3 1-50, по условиям округления они равнозначные. И в условиях округления, также нужно, чтобы если число двухзначное, то кратно 10. Т.е. в общем виде: 1-9 без округления, 10-99 кратно 10, 100 и выше кратно 100. Хотелось бы функцию ЕСЛИМН реализовать в макросе
Цитата
Вместо ваших 3-циклов используйте один
Здорово, сам не додумался бы так сделать


Сообщение отредактировал Markovich - Вторник, 29.12.2020, 07:54
 
Ответить
СообщениеKuzmich, большое спасибо за помощь! Но решение немного неверное: изначально, в диапазонах для генератора 1 (ячейки C5 - H5) числа могут быть абсолютно разные, например, в диапазоне 1 3000-15000, в диапазоне 2 50-300, в диапазоне 3 1-50, по условиям округления они равнозначные. И в условиях округления, также нужно, чтобы если число двухзначное, то кратно 10. Т.е. в общем виде: 1-9 без округления, 10-99 кратно 10, 100 и выше кратно 100. Хотелось бы функцию ЕСЛИМН реализовать в макросе
Цитата
Вместо ваших 3-циклов используйте один
Здорово, сам не додумался бы так сделать
Автор - Markovich
Дата добавления - 29.12.2020 в 07:54
Kuzmich Дата: Вторник, 29.12.2020, 17:33 | Сообщение № 4
Группа: Проверенные
Ранг: Ветеран
Сообщений: 711
Репутация: 156 ±
Замечаний: 0% ±

Excel 2003
Попробуйте так, макрос в модуль
[vba]
Код
Dim i As Long
Dim j As Long
Dim cell As Double

Sub random_service_Генератор_()
Application.ScreenUpdating = False
On Error Resume Next
Application.Calculation = xlManual
Dim Srv As Worksheet
  Set Srv = ThisWorkbook.Worksheets("service")
  Set Basic = ThisWorkbook.Worksheets("Общие данные")
       'СЛУЧ_МЕЖДУ = Int((верх_граница - нижн_граница + 1) * Rnd + нижн_граница)
Srv.Activate
For i = 11 To Range("K2")
    Randomize
       'Генератор 1
    Cells(i, "B") = Int((Cells(5, "D") - Cells(5, "C") + 1) * Rnd + Cells(5, "C"))
    Cells(i, "F") = Int((Cells(5, "F") - Cells(5, "E") + 1) * Rnd + Cells(5, "E"))
    Cells(i, "J") = Int((Cells(5, "H") - Cells(5, "G") + 1) * Rnd + Cells(5, "G"))
       'Определение диапазона для Генератора 2
    Cells(i, "C") = WorksheetFunction.RoundDown(Cells(i, "B") * 0.85, 0)
    Cells(i, "D") = WorksheetFunction.RoundUp(Cells(i, "B") * 1.15, 0)
    Cells(i, "G") = WorksheetFunction.RoundDown(Cells(i, "F") * 0.85, 0)
    Cells(i, "H") = WorksheetFunction.RoundUp(Cells(i, "F") * 1.15, 0)
    Cells(i, "K") = WorksheetFunction.RoundDown(Cells(i, "J") * 0.85, 0)
    Cells(i, "L") = WorksheetFunction.RoundUp(Cells(i, "J") * 1.15, 0)
       'Генератор 2
    For j = 14 To 23
      Randomize
      Cells(i, j) = Int((Cells(i, "D") - Cells(i, "C") + 1) * Rnd + Cells(i, "C"))
        cell = Cells(i, j)
          Call iRound
        Cells(i, j + 11) = cell
      Cells(i, j + 11) = Int((Cells(i, "H") - Cells(i, "G") + 1) * Rnd + Cells(i, "G"))
        cell = Cells(i, j + 11)
          Call iRound
        Cells(i, j + 11) = cell
      Cells(i, j + 22) = Int((Cells(i, "L") - Cells(i, "K") + 1) * Rnd + Cells(i, "K"))
        cell = Cells(i, j + 22)
          Call iRound
        Cells(i, j + 22) = cell
    Next
Next
Basic.Activate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Sub iRound()
   Select Case cell
     Case Is < 10
      cell = WorksheetFunction.Round(cell, 0)
     Case 10 To 100
       cell = WorksheetFunction.Round(cell, -1)
     Case Is > 100
       cell = WorksheetFunction.Round(cell, -2)
   End Select
End Sub
[/vba]
 
Ответить
СообщениеПопробуйте так, макрос в модуль
[vba]
Код
Dim i As Long
Dim j As Long
Dim cell As Double

Sub random_service_Генератор_()
Application.ScreenUpdating = False
On Error Resume Next
Application.Calculation = xlManual
Dim Srv As Worksheet
  Set Srv = ThisWorkbook.Worksheets("service")
  Set Basic = ThisWorkbook.Worksheets("Общие данные")
       'СЛУЧ_МЕЖДУ = Int((верх_граница - нижн_граница + 1) * Rnd + нижн_граница)
Srv.Activate
For i = 11 To Range("K2")
    Randomize
       'Генератор 1
    Cells(i, "B") = Int((Cells(5, "D") - Cells(5, "C") + 1) * Rnd + Cells(5, "C"))
    Cells(i, "F") = Int((Cells(5, "F") - Cells(5, "E") + 1) * Rnd + Cells(5, "E"))
    Cells(i, "J") = Int((Cells(5, "H") - Cells(5, "G") + 1) * Rnd + Cells(5, "G"))
       'Определение диапазона для Генератора 2
    Cells(i, "C") = WorksheetFunction.RoundDown(Cells(i, "B") * 0.85, 0)
    Cells(i, "D") = WorksheetFunction.RoundUp(Cells(i, "B") * 1.15, 0)
    Cells(i, "G") = WorksheetFunction.RoundDown(Cells(i, "F") * 0.85, 0)
    Cells(i, "H") = WorksheetFunction.RoundUp(Cells(i, "F") * 1.15, 0)
    Cells(i, "K") = WorksheetFunction.RoundDown(Cells(i, "J") * 0.85, 0)
    Cells(i, "L") = WorksheetFunction.RoundUp(Cells(i, "J") * 1.15, 0)
       'Генератор 2
    For j = 14 To 23
      Randomize
      Cells(i, j) = Int((Cells(i, "D") - Cells(i, "C") + 1) * Rnd + Cells(i, "C"))
        cell = Cells(i, j)
          Call iRound
        Cells(i, j + 11) = cell
      Cells(i, j + 11) = Int((Cells(i, "H") - Cells(i, "G") + 1) * Rnd + Cells(i, "G"))
        cell = Cells(i, j + 11)
          Call iRound
        Cells(i, j + 11) = cell
      Cells(i, j + 22) = Int((Cells(i, "L") - Cells(i, "K") + 1) * Rnd + Cells(i, "K"))
        cell = Cells(i, j + 22)
          Call iRound
        Cells(i, j + 22) = cell
    Next
Next
Basic.Activate
Application.Calculation = xlAutomatic
Application.ScreenUpdating = True
End Sub

Sub iRound()
   Select Case cell
     Case Is < 10
      cell = WorksheetFunction.Round(cell, 0)
     Case 10 To 100
       cell = WorksheetFunction.Round(cell, -1)
     Case Is > 100
       cell = WorksheetFunction.Round(cell, -2)
   End Select
End Sub
[/vba]
Автор - Kuzmich
Дата добавления - 29.12.2020 в 17:33
Markovich Дата: Среда, 30.12.2020, 07:33 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 50
Репутация: 0 ±
Замечаний: 0% ±

Excel 2019
Kuzmich, спасибо! Это то что нужно.
 
Ответить
СообщениеKuzmich, спасибо! Это то что нужно.
Автор - Markovich
Дата добавления - 30.12.2020 в 07:33
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Округление диапазона сгенерированных чисел по условию (Макросы/Sub)
  • Страница 1 из 1
  • 1
Поиск:

Яндекс.Метрика Яндекс цитирования
© 2010-2024 · Дизайн: MichaelCH · Хостинг от uCoz · При использовании материалов сайта, ссылка на www.excelworld.ru обязательна!