создания макроса для 50000 повторений

Старая форма входа

Страница 1 из 1 1
Модератор форума: китин, _Boroda_

создания макроса для 50000 повторений (Иное/Other)

snegovik2389

Дата: Воскресенье, 28.11.2021, 13:06 | Сообщение № 1

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

2019

Добрый день ,помогите пожалуйста есть файл ,который считает значения в ячейках B2 ,C2, D2 исходя из генерации случайных чисел, нужен макрос ,который будет каждый раз нажимать f9 для обновления результатов, затем после каждого нажатия f9 копировать полученный результат в столбцы I J K,нужно проделать эту операцию 50 000 раз то есть каждый раз генерировать число а затем копировать его в др столбцы получится 50000 строк, затем нужно просуммировать все значения в столбцах I J K и разделить их на 50000,это написано в формуле в ячейках I5,J5,K5.Спасибо за помощь. Комп средненький желательно как-то оптимизировать макрос чтобы он работал побыстрее.

К сообщению приложен файл: 8696645.xlsb (8.4 Kb)

Ответить

Gustav

Дата: Воскресенье, 28.11.2021, 14:39 | Сообщение № 2

Группа: Админы

Ранг: Участник клуба

Сообщений: 2797

Репутация: 1161 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Как-то так получилось (ну, и что там надо поделить/посчитать после генерации - сами сделайте формулами):
[vba]

Код

Sub main_run()
    Dim arr(1 To 50000, 1 To 3) As Integer
    Dim b2 As Integer, c2 As Integer, d2 As Integer
    Dim i As Long
    For i = 1 To 50000
        Randomize
        Select Case Rnd()
            Case Is <= 0.333333
                b2 = 1: c2 = 0: d2 = 0
            Case Is > 0.6666666
                b2 = 0: c2 = 0: d2 = 1
            Case Else
                b2 = 0: c2 = 1: d2 = 0
        End Select
        arr(i, 1) = b2: arr(i, 2) = c2: arr(i, 3) = d2
    Next i
    Range("I2:K50001") = arr
End Sub

[/vba]

МОИ: Ник, Tip box: 41001663842605

Ответить

bmv98rus

Дата: Воскресенье, 28.11.2021, 14:48 | Сообщение № 3

Группа: Друзья

Ранг: Участник клуба

Сообщений: 4115

Репутация: 769 ±

Замечаний: 0% ±

Excel 2013/2016

[vba]

Код

Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
Range("i2:k2").Resize(Cells.Rows.Count - 1).ClearContents

For i = 1 To Range("i1")
Range("b2:d4").Calculate
Range("i1:k1").Offset(i).Value = Range("b2:d2").Value
Next
Range("i1:k1").Offset([i1] + 1).FormulaR1C1 = "=SUM(R2C:R[-1]C)/R1C9"
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True

[/vba]

~~Замечательный~~ Временно просто медведь ~~, процентов на 20~~.

Ответить

snegovik2389

Дата: Суббота, 04.12.2021, 12:05 | Сообщение № 4

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

2019

Gustav, спасибо почти то что только мне нужно использовать макрос так чтобы в самом коде не было функции генератора случ числа ,я набросал вот вариант

[vba]

Код

Sub Макрос1()
'
' Макрос1 Макрос
'
' Сочетание клавиш: Ctrl+m
'
Range("B22").Select
Selection.Copy
Range("I2").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I3").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I4").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
Range("I5").Select
Selection.PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, SkipBlanks _
:=False, Transpose:=False
End Sub

[/vba]

только не могу понять как в этом коде сделать так чтобы копирование было на 50 000 строк ?

Ответить

Gustav

Дата: Суббота, 04.12.2021, 16:09 | Сообщение № 5

Группа: Админы

Ранг: Участник клуба

Сообщений: 2797

Репутация: 1161 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Цитата snegovik2389, 04.12.2021 в 12:05, в сообщении № 4 (

)

чтобы в самом коде не было функции генератора случ числа

Хм... а чем тогда вариант от bmv98rus не устраивает из сообщения № 3? Там нет генерации СЧ внутри процедуры...

Если вам нужно обязательно с Copy и PasteSpecial (зачем-то!) и без всяких ускоряющих фишек, то это долго будет, где-нибудь на полчаса. Например, вот банальная непричесанная процедура:
[vba]

Код

Sub main_run2()
    Dim i
    For i = 1 To 50000
        Range("B2:D2").Copy
        Range("I2:K2").Offset(i - 1).PasteSpecial xlPasteValues
    Next
End Sub

[/vba]
Только запустите сначала для 500 или 5000 повторений, чтобы понять как это небыстро.

МОИ: Ник, Tip box: 41001663842605

Ответить

snegovik2389

Дата: Воскресенье, 05.12.2021, 10:53 | Сообщение № 6

Группа: Пользователи

Ранг: Новичок

Сообщений: 15

Репутация: 0 ±

Замечаний: 0% ±

2019

Gustav,многда моя формула генерации будет чуть меняться, но ответы всегда будут в тех трех ячейках потому нужен макрос ,который берет именно ответы из трех ячеек не меняя формулу и генерирует их на 50000 строк, я запускал код от bmv98rus ,но почему-то он не работает ,вот приложил файл с кодом. Можете пжлста сказать в чем ошибка ?

К сообщению приложен файл: ___.xlsb (155.8 Kb)

Сообщение отредактировал snegovik2389 - Воскресенье, 05.12.2021, 10:56

Ответить

Gustav

Дата: Воскресенье, 05.12.2021, 15:38 | Сообщение № 7

Группа: Админы

Ранг: Участник клуба

Сообщений: 2797

Репутация: 1161 ±

Замечаний: ±

начинал с Excel 4.0, видел 2.1

Цитата snegovik2389, 05.12.2021 в 10:53, в сообщении № 6 (

)

в чем ошибка ?

В отсутствии в ячейке I1 значения верхней границы цикла, т.е. значения 50000, как это было в версии файла из сообщения № 1.

Соответственно, верхняя граница цикла при пустой ячейке I1 принимает значение 0, и цикл не работает.