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

Вход

Регистрация

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

 

= Мир MS Excel/Генерирование диапазона чисел на заданное количество строк - Мир MS Excel

Регистрация · Логин: · Пароль: · · Забыли пароль?
Страница 1 из 11
Модератор форума: _Boroda_, Pelena, Manyasha, SLAVICK 
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Генерирование диапазона чисел на заданное количество строк (Макросы/Sub)
Генерирование диапазона чисел на заданное количество строк
djon2012 Дата: Четверг, 15.06.2017, 08:01 | Сообщение № 1
Группа: Пользователи
Ранг: Участник
Сообщений: 73
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Здравствуйте!
Помогите пожалуйста решить задачу с помощью макроса. Суть задачи такова, нужно в строках (вручную вводить количество) сгенерировать числа от 1 до 1560 в порядке возрастания и без дубликатов. Количество сгенерированых чисел в строке 250.
Спасибо.
К сообщению приложен файл: 0949802.xlsb(12Kb)
 
Ответить
СообщениеЗдравствуйте!
Помогите пожалуйста решить задачу с помощью макроса. Суть задачи такова, нужно в строках (вручную вводить количество) сгенерировать числа от 1 до 1560 в порядке возрастания и без дубликатов. Количество сгенерированых чисел в строке 250.
Спасибо.

Автор - djon2012
Дата добавления - 15.06.2017 в 08:01
Gustav Дата: Четверг, 15.06.2017, 08:39 | Сообщение № 2
Группа: Друзья
Ранг: Старожил
Сообщений: 1410
Репутация: 541 ±
Замечаний: 0% ±

начинал с Excel 4.0...
Надо в порядке возрастания так:
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]


Мой tip box - яд 41001663842605

Сообщение отредактировал Gustav - Четверг, 15.06.2017, 14:51
 
Ответить
СообщениеНадо в порядке возрастания так:
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]

Автор - Gustav
Дата добавления - 15.06.2017 в 08:39
djon2012 Дата: Четверг, 15.06.2017, 19:58 | Сообщение № 3
Группа: Пользователи
Ранг: Участник
Сообщений: 73
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо Вам большое Gustav, макрос работает именно так как надо. Возможно я плохо пояснил суть задачи, но Вы поняли ее правильно. Дааа... знание сила, да шоб я, да вот такой макрос да вы шо. Еще раз спасибо Вам!!! hands hands hands
 
Ответить
СообщениеСпасибо Вам большое Gustav, макрос работает именно так как надо. Возможно я плохо пояснил суть задачи, но Вы поняли ее правильно. Дааа... знание сила, да шоб я, да вот такой макрос да вы шо. Еще раз спасибо Вам!!! hands hands hands

Автор - djon2012
Дата добавления - 15.06.2017 в 19:58
AndreTM Дата: Пятница, 16.06.2017, 01:28 | Сообщение № 4
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 496 ±
Замечаний: 0% ±

2003 & 2010
На самом деле, "псевдослучайность" в приведенном способе решения все же больше "псевдо", ну и при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла.

Больше все же подходят решения отсюда.
В качестве примера я заменил цикл поиска на тот, который приведен там (с учетом того, чтобы потом не сортировать результат, а использовать метод от Gustav - пришлось ввести дополнительный массив):

:)
К сообщению приложен файл: 10-34147-1.xlsb(32Kb)


Skype: andre.tm.007
Donate: Qiwi: 9517375010


Сообщение отредактировал AndreTM - Пятница, 16.06.2017, 01:29
 
Ответить
СообщениеНа самом деле, "псевдослучайность" в приведенном способе решения все же больше "псевдо", ну и при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла.

Больше все же подходят решения отсюда.
В качестве примера я заменил цикл поиска на тот, который приведен там (с учетом того, чтобы потом не сортировать результат, а использовать метод от Gustav - пришлось ввести дополнительный массив):

:)

Автор - AndreTM
Дата добавления - 16.06.2017 в 01:28
djon2012 Дата: Пятница, 16.06.2017, 07:17 | Сообщение № 5
Группа: Пользователи
Ранг: Участник
Сообщений: 73
Репутация: 0 ±
Замечаний: 0% ±

Excel 2010
Спасибо Вам AndreTM! Я проверил Ваш как это модно сказать проапгрейдженный вариант макроса от Gustavа, работает отлично к тому же в 3 раза быстрее. Большое спасибо Вам обоим за помощь в решении невыполнимой задачи :D :D :D


Сообщение отредактировал djon2012 - Пятница, 16.06.2017, 07:33
 
Ответить
СообщениеСпасибо Вам AndreTM! Я проверил Ваш как это модно сказать проапгрейдженный вариант макроса от Gustavа, работает отлично к тому же в 3 раза быстрее. Большое спасибо Вам обоим за помощь в решении невыполнимой задачи :D :D :D

Автор - djon2012
Дата добавления - 16.06.2017 в 07:17
Gustav Дата: Пятница, 16.06.2017, 12:05 | Сообщение № 6
Группа: Друзья
Ранг: Старожил
Сообщений: 1410
Репутация: 541 ±
Замечаний: 0% ±

начинал с Excel 4.0...
при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла


Блин! Так и думал, что кому-то придётся объяснять эту верхнюю "шестерку" в 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…
И т.д. - вообще выглядят почти как случайные, к тому же с идеально равномерным распределением.

В общем, я всё понял! Буду стараться больше не писать макросы на салфетке за завтраком. Ну, или хотя бы не забывать комментировать или более их "наглядить".


Мой tip box - яд 41001663842605
 
Ответить
Сообщение
при увеличении количества отбираемых чисел она начнет увеличивать количество итераций цикла


Блин! Так и думал, что кому-то придётся объяснять эту верхнюю "шестерку" в 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
Дата добавления - 16.06.2017 в 12:05
Gustav Дата: Пятница, 16.06.2017, 17:12 | Сообщение № 7
Группа: Друзья
Ранг: Старожил
Сообщений: 1410
Репутация: 541 ±
Замечаний: 0% ±

начинал с Excel 4.0...
Находясь под впечатлением от материала по ссылке от 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!


Мой tip box - яд 41001663842605
 
Ответить
СообщениеНаходясь под впечатлением от материала по ссылке от 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!

Автор - Gustav
Дата добавления - 16.06.2017 в 17:12
AndreTM Дата: Пятница, 16.06.2017, 18:11 | Сообщение № 8
Группа: Друзья
Ранг: Старожил
Сообщений: 1762
Репутация: 496 ±
Замечаний: 0% ±

2003 & 2010
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 :)

То есть да, "на салфетках писать не надо" :D


Skype: andre.tm.007
Donate: Qiwi: 9517375010
 
Ответить
Сообщение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 :)

То есть да, "на салфетках писать не надо" :D

Автор - AndreTM
Дата добавления - 16.06.2017 в 18:11
Мир MS Excel » Вопросы и решения » Вопросы по VBA » Генерирование диапазона чисел на заданное количество строк (Макросы/Sub)
Страница 1 из 11
Поиск:

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