Форум программистов, компьютерный форум, киберфорум
VBA
Войти
Регистрация
Восстановить пароль
 
Рейтинг 4.81/26: Рейтинг темы: голосов - 26, средняя оценка - 4.81
0 / 0 / 0
Регистрация: 20.08.2014
Сообщений: 4
1

Создать генератор случайных чисел с вычеркиванием сгенерированных чисел

20.08.2014, 21:19. Просмотров 5045. Ответов 15
Метки нет (Все метки)

Помогите пож. решить задачку:

1 Есть диапазон чисел от 1 до «i»
2 Необходимо выбрать случайное целое число от 1 до «i» = «y»
3 Работа макроса с этой переменной «y»
4 Из диапазона п.1. необходимо убрать «у» т.е. числовой ряд от 1 до «i» кроме «y»
5 Из оставшегося числового ряда необходимо выбрать случайное целое число и повторить с п.3. до того момента пока ряд не станет пустым.
6. Если ряд пустой MsgBox «Нет чисел»

Заранее спасибо!
0
Programming
Эксперт
94731 / 64177 / 26122
Регистрация: 12.04.2006
Сообщений: 116,782
20.08.2014, 21:19
Ответы с готовыми решениями:

Нужен генератор случайных чисел
Есть текстовый массив данных в виде таблицы (100 вопросов), с помощью ГСЧ в ячейках A1:A5,...

Написать генератор случайных чисел
написать генератор случайных чисел

Генератор случайных чисел с условием
Здравствуйте, помогите пожалуйста в реализации следующей задачи. Необходимо сгенерировать все...

Генератор случайных уникальных чисел в строке
Помогите неумехе! Я только учусь Задача: в Excel 2007 есть определенное кол-во столбцов и строк...

15
11025 / 3472 / 602
Регистрация: 13.02.2009
Сообщений: 10,330
20.08.2014, 23:02 2
В словарь все числа.
Выбирать случайное из Count словаря.
Отработанные - Remove
1
6057 / 1301 / 193
Регистрация: 12.12.2012
Сообщений: 1,019
20.08.2014, 23:16 3
Лучший ответ Сообщение было отмечено Аксима как решение

Решение

Здравствуйте, goldwik,
Набросал простенький, но удобный для решения предложенной вами задачи класс.

Класс называется AksiExhaustiveRnd и включает в себя метод Init, выполняющий пункт 1 вашего задания, и функцию PickY, выполняющую пункты 2 и 4 задания. Остальные пункты выполняются демонстрационной процедурой, которая вместе с классом находится в прилагаемом файле.

P.S. на всякий случай привожу листинги класса и процедуры, вдруг по той или иной причине (но точно не из за "слабого рейтинга") вы не сможете скачать файл.

Код класса:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
Dim n As Long, nums() As Long
'Процедура для инициализации массива (представляющего собой
'основу данного класса) диапазоном чисел от 1 до i.
Public Sub Init(ByVal i As Long)
    n = i
    ReDim nums(1 To i) As Long
    For i = 1 To n
        nums(i) = i
    Next i
End Sub
'Функция, случайным образом выбирающая очередное значение y из массива.
'Возвращает True, если из массива было выбрано очередное значение,
'или False, если массив исчерпан.
Public Function PickY(ByRef y As Long) As Boolean
    Dim i As Long, pos As Long
    If n > 0 Then 'Если в массиве еще есть числа...
        '1) Получаем позицию, откуда берется число.
        pos = Int(Rnd() * n) + 1
        '2) Берем число.
        y = nums(pos)
        '3) Удаляем число из массива.
        nums(pos) = nums(n)
        '4) Уменьшаем счетчик количества чисел в массиве.
        n = n - 1
        PickY = True
    End If
End Function
Код основного модуля:

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
'Процедура для демонстрации использования класса AksiExhaustiveRnd
Sub UseExhaustiveRnd()
    Dim i As Long, y As Long, eRnd As AksiExhaustiveRnd
    While i <= 0
        i = InputBox("Введите i - верхнюю границу диапазона случайных чисел", "Ввод i")
        If i <= 0 Then MsgBox "Число i должно быть положительным.", vbExclamation, "Ошибка"
    Wend
    Set eRnd = New AksiExhaustiveRnd
    eRnd.Init i
    While eRnd.PickY(y)
        '--------Обработка значения у--------
        MsgBox "Обрабатывается значение y = " & y & "."
        '--------Обработка значения у--------
    Wend
    MsgBox "Нет чисел."
End Sub
С уважением,
Aksima
1
Вложения
Тип файла: rar ExhaustiveRandomGenerator.rar (12.2 Кб, 25 просмотров)
11025 / 3472 / 602
Регистрация: 13.02.2009
Сообщений: 10,330
20.08.2014, 23:18 4
Примитивно так:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Sub QWERT()
    Dim i, Y, K
    K = 10
    Randomize
    Dim OD: Set OD = CreateObject("Scripting.Dictionary")
    For i = 1 To K: OD(i) = i: Next i
    Do Until OD.Count = 0
        Do
            i = Int(K * Rnd + 1)
        Loop While Not OD.exists(i)
        Debug.Print i
        OD.Remove (i)
    Loop
    MsgBox "OK"
End Sub
1
Модератор
8098 / 3035 / 805
Регистрация: 22.02.2013
Сообщений: 4,325
Записей в блоге: 78
21.08.2014, 02:29 5
Лучший ответ Сообщение было отмечено Аксима как решение

Решение

Aksima, необязательно "сдвигать" весь массив, достаточно обменять одну выборку, как я делал тут. Исходя из задания (числа от 1), можно вообще обойтись без установки массива:
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
Option Explicit
 
Private Sub Form_Load()
    Dim i       As Long
    Dim r()     As Long
    Dim max     As Long
    
    ' Максимальное число
    max = 1000
    ReDim r(max - 1)
    
    ' Инициализация
    NextRnd True, max
    
    ' Заполнение
    For i = 0 To max - 1
        r(i) = NextRnd
    Next
 
    ' Сортировка для проверки
    qSortLong r
    
    ' Проверка
    For i = 0 To max - 1
        If r(i) <> i + 1 Then Stop
    Next
    
End Sub
 
' Для инициализации передаем первым параметром True, вторым максимальное число
Private Function NextRnd(Optional ByVal Reset As Boolean, Optional ByVal i As Long = 1000) As Long
    Static dat() As Long, Idx As Long, Count As Long
    
    If Reset Then Count = i: ReDim dat(Count - 1): Exit Function
    If Count = 0 Then MsgBox "Нет чисел": Exit Function
    Idx = Int(Rnd * Count): NextRnd = dat(Idx): Count = Count - 1
    If NextRnd = 0 Then NextRnd = Idx + 1
    If dat(Count) = 0 Then dat(Idx) = Count + 1 Else dat(Idx) = dat(Count)
End Function
2
3223 / 1171 / 295
Регистрация: 07.08.2013
Сообщений: 2,946
21.08.2014, 08:29 6
когда-то делал "пятнашки" на аксе
написал вот это - может поможет

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
Erase Position()
 
For i = 1 To 4
For j = 1 To 4
 
aaa:
    'генерируем число от 1 до 16 и проверяем его на наличие в массиве
    'если есть то повторяем заново если нет то добавляем в массив
    'в итоге получаем массив 4х4 заполненный неповторяющимся числами от 1 до 16
    'начинать диапазон чисел с 0 нельзя т.к. цикл проверки может уйти в нирвану
    'число 16 - это пустая клеточка
    asd = CInt(Int(16 * Rnd() + 1))
    For m = 1 To 4
    For n = 1 To 4
        If asd = Position(m, n) Then GoTo aaa
    Next n
    Next m
Position(i, j) = asd
Next j
Next i
1
0 / 0 / 0
Регистрация: 20.08.2014
Сообщений: 4
21.08.2014, 13:26  [ТС] 7
Огромное СПАСИБО!!! Логика понятна.

Добавлено через 51 минуту
Цитата Сообщение от Aksima Посмотреть сообщение
Класс называется AksiExhaustiveRnd и включает в себя метод Init, выполняющий пункт 1 вашего задания, и функцию PickY, выполняющую пункты 2 и 4 задания. Остальные пункты выполняются демонстрационной процедурой, которая вместе с классом находится в прилагаемом файле.
У меня нет возможности скачать файл (слабый рейтинг для скачивания). Выложите пожалуйста файл на внешний ресурс (сожалею, но размещать на форуме ссылки на файлопомойки запрещено - и не дезинформируйте людей, никакого рейтинга для скачивания не нужно - прим. модератора) Заранее благодарен.

Добавлено через 59 минут
Спасибо!
0
3223 / 1171 / 295
Регистрация: 07.08.2013
Сообщений: 2,946
22.08.2014, 06:08 8
Вот вам еще вариант
(писалось под Excel так что есть присвоение ячейке Cells(i,2))
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
Dim LongMax As Long
    LongMax = 100 'максимальное число
    Dim StrArr As String
    For i = 1 To LongMax: StrArr = StrArr & "'" & i & "',": Next i 'собираем все числа в одну строку
    Dim a() As String
    
    Randomize
    For i = LongMax To 1 Step -1
    Erase a()
    a() = Split(Left(StrArr, Len(StrArr) - 1), ",") ' делаем из строки одномерный массив
    iRND = CLng(Int(i * Rnd() + 1)) ' генерируем случайное число
    Cells(i, 2) = CLng(Replace(a(iRND - 1), "'", "")) ' заносим число в ячейку
    StrArr = Replace(StrArr, a(iRND - 1) & ",", "") 'удаляем число из массива
    Next i
    MsgBox "Нет чисел"
0
6057 / 1301 / 193
Регистрация: 12.12.2012
Сообщений: 1,019
22.08.2014, 16:50 9
Провел сравнительный анализ всех вариантов генераторов случайных чисел.
Мой вариант и вариант The trick - практически идентичны по быстродействию, хотя мой чуть лучше на больших объемах данных. Варианты snipe - самые затратные по времени (хотя вариант, основанный на игре в пятнашки, оказался лучше, чем вариант с использованием строки). Ну а вариант Alex77755 занимает промежуточное положение.
1
Миниатюры
Создать генератор случайных чисел с вычеркиванием сгенерированных чисел  
Вложения
Тип файла: rar RandomGeneratorsComparsion.rar (33.1 Кб, 21 просмотров)
Модератор
8098 / 3035 / 805
Регистрация: 22.02.2013
Сообщений: 4,325
Записей в блоге: 78
22.08.2014, 17:03 10
Цитата Сообщение от Aksima Посмотреть сообщение
хотя мой чуть лучше на больших объемах данных.
Твой первый вариант не быстрее (где ты сдвигал массив). Также при частых объявлениях (например малый диапазон, но частый вызов), она будет медленней из-за постоянной инициализации. Каждый метод подходит под разные случаи.
0
11025 / 3472 / 602
Регистрация: 13.02.2009
Сообщений: 10,330
23.08.2014, 10:20 11
Aksima,
Провел сравнительный анализ
Решил проверить. Делал так:
Кликните здесь для просмотра всего текста
Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
Option Explicit
'Процедура для демонстрации использования класса AksiExhaustiveRnd
Sub UseExhaustiveRnd()
    Dim i As Long, Y As Long, eRnd As AksiExhaustiveRnd, t
   i = 100000
   t = Time
'    While i <= 0
'
'        i = InputBox("Введите i - верхнюю границу диапазона случайных чисел", "Ввод i")
'        If i <= 0 Then MsgBox "Число i должно быть положительным.", vbExclamation, "Ошибка"
'    Wend
    Set eRnd = New AksiExhaustiveRnd
    eRnd.Init i
    While eRnd.PickY(Y)
        '--------Обработка значения у--------
'        MsgBox "Обрабатывается значение y = " & y & "."
        '--------Обработка значения у--------
    Wend
    Debug.Print "Класс", i, Format(Time - t, "nn:ss")
    MsgBox "Нет чисел.", , Time - t
 
End Sub
 
Sub QWERT()
    Dim i, Y, K, t
    K = 100000
    t = Time
    Randomize
    Dim OD: Set OD = CreateObject("Scripting.Dictionary")
    For i = 1 To K: OD(i) = i: Next i
    Do Until OD.Count = 0
        Do
            i = Int(K * Rnd + 1)
        Loop While Not OD.exists(i)
'        Debug.Print i
        OD.Remove (i)
    Loop
'    MsgBox "OK"
     Debug.Print "Словарь", K, Format(Time - t, "nn:ss")
     MsgBox "Нет чисел.", , Time - t
End Sub

В дебаггере:
Класс 100000 01:27
Словарь 100000 00:30
Что я сделал не правильно?
У меня был тормоз в
Visual Basic
1
Debug.Print i
0
Модератор
8098 / 3035 / 805
Регистрация: 22.02.2013
Сообщений: 4,325
Записей в блоге: 78
23.08.2014, 11:01 12
Цитата Сообщение от Alex77755 Посмотреть сообщение
Что я сделал не правильно?
Алгоритмически словарь - самый медленный и нерациональный, и я вообще не рекомендую его, т.к. когда диапазон не слишком большой алгоритм будет "подбирать" числа и гонять лишние циклы. Если бы VBA позволял компилировать (если этот код написать на VB6), то словарь намного отстанет. В словаре только одно преобразование число-строка в десятки раз медленней чем непосредственно выборка из массива, по памяти занимает намного больше. Самые быстрые алгоритмы это вариант Aksima и мой.
1
6057 / 1301 / 193
Регистрация: 12.12.2012
Сообщений: 1,019
23.08.2014, 12:18 13
Цитата Сообщение от Alex77755 Посмотреть сообщение
Что я сделал не правильно?
Вы все сделали правильно, просто я хотел оставить в посте №3 старый вариант моего класса для истории, чтобы пользователи видели мои ошибки и то, каким путем этот класс был улучшен в посте №9. Но, поскольку это привело к недоразумению - перезалил файл и отредактировал листинги в посте №3, чтобы они согласовывались с версией в посте №9.

С уважением,
Aksima
1
Заблокирован
23.08.2014, 18:19 14
Эх, жаль не успел к раздаче лучших ответов

Visual Basic
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
Option Explicit
 
Sub FixRnd()
    'Процедура выбирает и не разу не повторяет числа из указанного диапазона
    '
    Const num = 20, z = ", "
    Dim f&, s$, s1, n&, j$()
    For f = 1 To num: s = s & " " & f - 1: Next
    j = Split(Mid$(s, 2)): Randomize Timer
    Do
        n = j(Fix(Rnd * (UBound(j) + 1))): s = " " & Join(j) & " "
        s = Replace(s, " " & n & " ", " ")
        j = Split(Trim(s))
        s1 = s1 & z & n
    Loop While UBound(j): s1 = s1 & z & j(0)
    Debug.Print "Выбранны:", Mid$(s1, 3)
    MsgBox "Выбранны: " & Mid$(s1, 3)
End Sub


Выполняется мгновенно
0
The trick
23.08.2014, 18:26
  #15

Не по теме:

Цитата Сообщение от Антихакер32 Посмотреть сообщение
Выполняется мгновенно
:rofl: это еще медленней словаря.

0
Заблокирован
23.08.2014, 18:38 16
Добавлено через 8 минут
ладно, в следующий раз, постараюсь ответить первым
..если результаты будут на второй странице, то я понял!, что тема себя исчерпала
и отвечать по ней, не стоит, потому что те кто ответил первее всегда будут правее, верно-же (не всегда - прим. модератора)
0
IT_Exp
Эксперт
87844 / 49110 / 22898
Регистрация: 17.06.2006
Сообщений: 92,604
23.08.2014, 18:38

Заказываю контрольные, курсовые, дипломные и любые другие студенческие работы здесь.

С помощью генератора случайных чисел создать и вывести на экран массив случайных действительных чисел
Задача №1: С помощью генератора случайных чисел создать и вывести на экран массив А 10x10...

С помощью генератора случайных чисел необходимо создать массив
Здравствуйте! С помощью генератора случайных чисел необходимо создать массив на, скажем, 25...

Из 3000 случайных чисел создать массив и вывести его на лист
Здравствуйте, мне нужно из 3000 случайных чисел создать массив и вывести его на лист. Потом из этих...

Сформировать массив из десяти чисел с помощью генератора случайных чисел
Сформировать массив из десяти чисел с помощью генератора случайных чисел. Найти сумму элементов...


Искать еще темы с ответами

Или воспользуйтесь поиском по форуму:
16
Ответ Создать тему
Опции темы

КиберФорум - форум программистов, компьютерный форум, программирование
Powered by vBulletin® Version 3.8.9
Copyright ©2000 - 2020, vBulletin Solutions, Inc.