Здравствуйте! Помогите пожалуйста решить задачу с помощью макроса. Суть задачи такова, нужно в строках (вручную вводить количество) сгенерировать числа от 1 до 1560 в порядке возрастания и без дубликатов. Количество сгенерированых чисел в строке 250. Спасибо.
Здравствуйте! Помогите пожалуйста решить задачу с помощью макроса. Суть задачи такова, нужно в строках (вручную вводить количество) сгенерировать числа от 1 до 1560 в порядке возрастания и без дубликатов. Количество сгенерированых чисел в строке 250. Спасибо.djon2012
Надо в порядке возрастания так: 1,2,3...248,249,250 251,252,253...498,499,500 и т.д.? Или как-то иначе?
А то в примере какая-то странная последовательность... вразнобой...
Ааа, кажется понял - надо в произвольной строке заполнить 250 ячеек случайными числами от 1 до 1560. Уникальность ограничивается только внутри строки, т.е. в двух соседних строках могут уже встречаться повторы (в примере это числа 27, 30, 47 и др.).
Тогда примерно так (запускать надо первую подпрограмму): [vba]
Код
Sub fullLoop() Dim num As Integer Dim i As Integer
num = InputBox("Задайте количество строк генерации")
For i = 1 To num Call generate1560(i) Next i End Sub
Sub generate1560(row)
Dim a(1 To 1560) As Integer Dim i As Integer Dim r As Integer Dim cnt As Integer Dim v(1 To 1, 1 To 250) As Integer
cnt = 0 Do For i = 1 To 1560 r = WorksheetFunction.RandBetween(1, 6) If r = 1 And a(i) = 0 Then a(i) = 1 cnt = cnt + 1 If cnt = 250 Then Exit For End If Next i Loop Until cnt = 250
cnt = 0 For i = 1 To 1560 If a(i) = 1 Then cnt = cnt + 1 v(1, cnt) = i End If Next i
Range(Cells(row, 1), Cells(row, 250)).Value = v End Sub
[/vba]
Надо в порядке возрастания так: 1,2,3...248,249,250 251,252,253...498,499,500 и т.д.? Или как-то иначе?
А то в примере какая-то странная последовательность... вразнобой...
Ааа, кажется понял - надо в произвольной строке заполнить 250 ячеек случайными числами от 1 до 1560. Уникальность ограничивается только внутри строки, т.е. в двух соседних строках могут уже встречаться повторы (в примере это числа 27, 30, 47 и др.).
Тогда примерно так (запускать надо первую подпрограмму): [vba]
Код
Sub fullLoop() Dim num As Integer Dim i As Integer
num = InputBox("Задайте количество строк генерации")
For i = 1 To num Call generate1560(i) Next i End Sub
Sub generate1560(row)
Dim a(1 To 1560) As Integer Dim i As Integer Dim r As Integer Dim cnt As Integer Dim v(1 To 1, 1 To 250) As Integer
cnt = 0 Do For i = 1 To 1560 r = WorksheetFunction.RandBetween(1, 6) If r = 1 And a(i) = 0 Then a(i) = 1 cnt = cnt + 1 If cnt = 250 Then Exit For End If Next i Loop Until cnt = 250
cnt = 0 For i = 1 To 1560 If a(i) = 1 Then cnt = cnt + 1 v(1, cnt) = i End If Next i
Range(Cells(row, 1), Cells(row, 250)).Value = v End Sub
Спасибо Вам большое Gustav, макрос работает именно так как надо. Возможно я плохо пояснил суть задачи, но Вы поняли ее правильно. Дааа... знание сила, да шоб я, да вот такой макрос да вы шо. Еще раз спасибо Вам!!!
Спасибо Вам большое Gustav, макрос работает именно так как надо. Возможно я плохо пояснил суть задачи, но Вы поняли ее правильно. Дааа... знание сила, да шоб я, да вот такой макрос да вы шо. Еще раз спасибо Вам!!! djon2012
На самом деле, "псевдослучайность" в приведенном способе решения все же больше "псевдо", ну и при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла.
Больше все же подходят решения отсюда. В качестве примера я заменил цикл поиска на тот, который приведен там (с учетом того, чтобы потом не сортировать результат, а использовать метод от Gustav - пришлось ввести дополнительный массив):
[vba]
Код
Sub generate1560(row)
Dim a(1 To 1560) As Integer, b(1 To 1560) As Integer Dim i As Integer Dim r As Integer Dim cnt As Integer Dim v(1 To 1, 1 To 250) As Integer
For i = 1 To 1560 b(i) = i Next
For i = 1560 To 1560 - 250 + 1 Step -1 r = WorksheetFunction.RandBetween(1, i) temp = b(r) b(r) = b(i) b(i) = temp a(temp) = 1 Next i
cnt = 0 For i = 1 To 1560 If a(i) = 1 Then cnt = cnt + 1 If cnt > 250 Then Exit For v(1, cnt) = i End If Next i
Range(Cells(row, 1), Cells(row, 250)).Value = v
End Sub
[/vba]
На самом деле, "псевдослучайность" в приведенном способе решения все же больше "псевдо", ну и при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла.
Больше все же подходят решения отсюда. В качестве примера я заменил цикл поиска на тот, который приведен там (с учетом того, чтобы потом не сортировать результат, а использовать метод от Gustav - пришлось ввести дополнительный массив):
[vba]
Код
Sub generate1560(row)
Dim a(1 To 1560) As Integer, b(1 To 1560) As Integer Dim i As Integer Dim r As Integer Dim cnt As Integer Dim v(1 To 1, 1 To 250) As Integer
For i = 1 To 1560 b(i) = i Next
For i = 1560 To 1560 - 250 + 1 Step -1 r = WorksheetFunction.RandBetween(1, i) temp = b(r) b(r) = b(i) b(i) = temp a(temp) = 1 Next i
cnt = 0 For i = 1 To 1560 If a(i) = 1 Then cnt = cnt + 1 If cnt > 250 Then Exit For v(1, cnt) = i End If Next i
Спасибо Вам AndreTM! Я проверил Ваш как это модно сказать проапгрейдженный вариант макроса от Gustavа, работает отлично к тому же в 3 раза быстрее. Большое спасибо Вам обоим за помощь в решении невыполнимой задачи
Спасибо Вам AndreTM! Я проверил Ваш как это модно сказать проапгрейдженный вариант макроса от Gustavа, работает отлично к тому же в 3 раза быстрее. Большое спасибо Вам обоим за помощь в решении невыполнимой задачи djon2012
Сообщение отредактировал djon2012 - Пятница, 16.06.2017, 07:33
при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла
Блин! Так и думал, что кому-то придётся объяснять эту верхнюю "шестерку" в RandBetween(1, 6), но не думал, что Вам Да, она не так очевидна, как другие константы 1560 и 250, но она именно результат этих других констант =Int(1560/250) (а вовсе не имитация игральной кости).
Смысл - получить внутри 1560 чисел наборы по 250+ чисел. Но поскольку RandBetween действительно "псевдослучайна", то 250+ она абсолютно не гарантирует - тесты показали, что иногда получаются наборы из 250- чисел, т.е. с недостатком до желаемого.
Чтобы застраховаться от ситуации 250- и был придуман внешний цикл Do. Но не будем совсем уж сурово ругать RandBetween - какую-никакую равномерность генерации она всё же обеспечивает. Поэтому в двух циклах For i = 1 To 1560 мы уж совершенно точно наберем нужные 250 чисел. Причём, в первом цикле получим большую часть этого количества, а во втором - недостающий остаточек - ну 10, ну 20 чисел максимум, после чего цикл досрочно прервётся.
Так что число итераций Do-цикла почти постоянно и равно 1 или 1 с хвостиком. Да, этот "хвостик" немножко завалит нам влево (потому что новый цикл For опять начнётся с единицы) равномерность распределения внутри 1560, увеличив "псевдОсистость", но, думаю, эта "псевда" будет не очень страшной - ведь, в конце концов, даже монотонные наборы типа 1-250, 251-500 и т.д. подходят под условия первоначальной постановки (гы-гы), а наборы с постоянным шагом типа: 1,7,13… 2,8,14… 3,9,15… И т.д. - вообще выглядят почти как случайные, к тому же с идеально равномерным распределением.
В общем, я всё понял! Буду стараться больше не писать макросы на салфетке за завтраком. Ну, или хотя бы не забывать комментировать или более их "наглядить".
при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла
Блин! Так и думал, что кому-то придётся объяснять эту верхнюю "шестерку" в RandBetween(1, 6), но не думал, что Вам Да, она не так очевидна, как другие константы 1560 и 250, но она именно результат этих других констант =Int(1560/250) (а вовсе не имитация игральной кости).
Смысл - получить внутри 1560 чисел наборы по 250+ чисел. Но поскольку RandBetween действительно "псевдослучайна", то 250+ она абсолютно не гарантирует - тесты показали, что иногда получаются наборы из 250- чисел, т.е. с недостатком до желаемого.
Чтобы застраховаться от ситуации 250- и был придуман внешний цикл Do. Но не будем совсем уж сурово ругать RandBetween - какую-никакую равномерность генерации она всё же обеспечивает. Поэтому в двух циклах For i = 1 To 1560 мы уж совершенно точно наберем нужные 250 чисел. Причём, в первом цикле получим большую часть этого количества, а во втором - недостающий остаточек - ну 10, ну 20 чисел максимум, после чего цикл досрочно прервётся.
Так что число итераций Do-цикла почти постоянно и равно 1 или 1 с хвостиком. Да, этот "хвостик" немножко завалит нам влево (потому что новый цикл For опять начнётся с единицы) равномерность распределения внутри 1560, увеличив "псевдОсистость", но, думаю, эта "псевда" будет не очень страшной - ведь, в конце концов, даже монотонные наборы типа 1-250, 251-500 и т.д. подходят под условия первоначальной постановки (гы-гы), а наборы с постоянным шагом типа: 1,7,13… 2,8,14… 3,9,15… И т.д. - вообще выглядят почти как случайные, к тому же с идеально равномерным распределением.
В общем, я всё понял! Буду стараться больше не писать макросы на салфетке за завтраком. Ну, или хотя бы не забывать комментировать или более их "наглядить".Gustav
Находясь под впечатлением от материала по ссылке от AndreTM, запилил еще один учебно-тренировочный вариант с использованием ScriptControl и языка jscript. Переложил на эту "феню" вариант от MCH по ссылке. Основная и почти бесплатная плюшка в дополнение к его варианту - встроенная в JS сортировка массива. Всё получилось весьма компактно и по скорости тоже приятно. [vba]
Код
Sub runLotto2() Dim sc As Object, js As String Dim num As Integer, i As Integer Dim bottom As Long, top As Long, amount As Long
js = js & "function lotto2(bottom, top, amount) {" js = js & " var rndArr = []; var outArr = [];" js = js & " for (var i = bottom; i <= top; rndArr[i] = i++);" js = js & " for (i = 1; i <= amount; i++) {" js = js & " var j = Math.floor(Math.random() * (top - bottom + 1)) + bottom;" js = js & " outArr[i] = rndArr[j]; rndArr[j] = rndArr[bottom++]; }" js = js & " return outArr.slice(1).sort(function(a,b){return a-b}).toString(); }"
Set sc = CreateObject("ScriptControl"): sc.Language = "jscript": sc.Addcode js
bottom = 1: top = 1560: amount = 250
num = Val(InputBox("Задайте количество строк генерации")) For i = 1 To num With Range(Cells(i, 1), Cells(i, 250)) .Value = Split(sc.Run("lotto2", bottom, top, amount), ",") .Value = .Value '<- чтобы текст превратить в числа в ячейках End With Next i End Sub
[/vba] Пора-пора поплотнее трогать JavaScript!
Находясь под впечатлением от материала по ссылке от AndreTM, запилил еще один учебно-тренировочный вариант с использованием ScriptControl и языка jscript. Переложил на эту "феню" вариант от MCH по ссылке. Основная и почти бесплатная плюшка в дополнение к его варианту - встроенная в JS сортировка массива. Всё получилось весьма компактно и по скорости тоже приятно. [vba]
Код
Sub runLotto2() Dim sc As Object, js As String Dim num As Integer, i As Integer Dim bottom As Long, top As Long, amount As Long
js = js & "function lotto2(bottom, top, amount) {" js = js & " var rndArr = []; var outArr = [];" js = js & " for (var i = bottom; i <= top; rndArr[i] = i++);" js = js & " for (i = 1; i <= amount; i++) {" js = js & " var j = Math.floor(Math.random() * (top - bottom + 1)) + bottom;" js = js & " outArr[i] = rndArr[j]; rndArr[j] = rndArr[bottom++]; }" js = js & " return outArr.slice(1).sort(function(a,b){return a-b}).toString(); }"
Set sc = CreateObject("ScriptControl"): sc.Language = "jscript": sc.Addcode js
bottom = 1: top = 1560: amount = 250
num = Val(InputBox("Задайте количество строк генерации")) For i = 1 To num With Range(Cells(i, 1), Cells(i, 250)) .Value = Split(sc.Run("lotto2", bottom, top, amount), ",") .Value = .Value '<- чтобы текст превратить в числа в ячейках End With Next i End Sub
Gustav, про "шестёрку" я отлично понимаю, что это не кубик , а что "вероятность отбора данного числа равна 1/6 ~ 250/1560".
На самом деле, я указывал на то, что RandBetween будет хорошо работать на "коротких" выборках (на самом деле, примерный коэффициент известен, выборка должна быть не более 1/20 от всего диапазона), так что даже на данной выборке (250 из 1560) сам алгоритм начинает ошибаться и достаточной "случайности не" дает.
Ну а то, что функция стала бы "подтормаживать" при возрастании числа отбираемых значений - это тоже, из-за того, что проверку на "неиспользованность" ( a(i)=0 ) надо выполнять до того, как пытаться генерировать "подходит ли число?". А то исходный вариант при повторных циклах запускал бы рандом все равно, несмотря на то,что позиция уже "отобрана".
Вообще, вместо RandBetween(1,6)=1 достаточно было использовать хотя бы Rnd()<250/1560. А то ведь что получается? Если, например, нам надо будет отбирать 1000 из 1560, то формула вообще не сработает: Int(1560/1000) = 1 = Top = Bottom => RandomBetween(1,1) = 1 = TrueAlways
То есть да, "на салфетках писать не надо"
Gustav, про "шестёрку" я отлично понимаю, что это не кубик , а что "вероятность отбора данного числа равна 1/6 ~ 250/1560".
На самом деле, я указывал на то, что RandBetween будет хорошо работать на "коротких" выборках (на самом деле, примерный коэффициент известен, выборка должна быть не более 1/20 от всего диапазона), так что даже на данной выборке (250 из 1560) сам алгоритм начинает ошибаться и достаточной "случайности не" дает.
Ну а то, что функция стала бы "подтормаживать" при возрастании числа отбираемых значений - это тоже, из-за того, что проверку на "неиспользованность" ( a(i)=0 ) надо выполнять до того, как пытаться генерировать "подходит ли число?". А то исходный вариант при повторных циклах запускал бы рандом все равно, несмотря на то,что позиция уже "отобрана".
Вообще, вместо RandBetween(1,6)=1 достаточно было использовать хотя бы Rnd()<250/1560. А то ведь что получается? Если, например, нам надо будет отбирать 1000 из 1560, то формула вообще не сработает: Int(1560/1000) = 1 = Top = Bottom => RandomBetween(1,1) = 1 = TrueAlways