Поиск  Пользователи  Правила  Войти
Форумы "Планета Excel" » Вопросы по Microsoft Excel
Страницы: 1
RSS
Сгенерировать случайные неповторяющиеся числа
 
#1
19.02.2019 10:41:44
Уважаемые знатоки,
пожалуйста помогите с написанием кода. Вот код:
Код
Sub Randomnumber()
Dim Rand As Range
 Randomize
 For Each Rand In Range("D11").Resize(Range("B13").Value, 1)
 Rand = WorksheetFunction.RandBetween(1, Range("B11"))
 Next Rand
End Sub
который генерирует определенное количество случайных чисел (количество определяется числом из ячейки "В13") из диапазона между 1 и цифрой указанной в ячейке "В11". В силу необходимости использования этого генератора в работе, нужно чтоб он не создавал случайные числа, которые повторяются. Помогите с кодом. Заранее благодарен.  
 
 
 
#2
19.02.2019 11:00:50
Rnd[(Number)]
Функция Rnd(Random) служит для генерации случайных чисел

Возвращаемое значение
Функция Rnd возвращает значение в диапазоне от 0 до 1 типа Single, содержащее случайное число (причем 1 не входит в этот диапазон, а 0 входит). Строго говоря, функция возвращает псевдослучайные числа. При каждом запуске программы, функция генерирует одну и ту же последовательность случайных чисел. Во избежания этого явления используйте инструкцию Randomize

Примечание:Чтобы получить значения случайных чисел в интервале от min до max используйте формулу:
Int((max - min + 1) * Rnd + min), где min и max-минимальное и максимальное число соответственно
 
 
 
#3
19.02.2019 11:12:18
said.makhmudov,
Код
Sub Randomnumber()
'  Randomize
  With Range("D11").Resize(Range("B13").Value, 1)
    .Formula = "=RAND()"
    .Value = Evaluate(Replace("INDEX(RANK(@,@),)", "@", .Address(, , Application.ReferenceStyle)))
  End With
End Sub
 
 
 
#4
19.02.2019 11:52:12
OFF
said.makhmudov, "случайность" теряется при введении правил. Помнится, старина Джобс сказал: «Нам пришлось сделать iPod менее случайным, чтобы он казался более случайным» (о том, чтобы стоящие рядом композиции не воспроизводились подряд)  ;)  Решение вам уже дали)
Изменено: Jack Famous - 19.02.2019 11:54:04
Во всех делах очень полезно периодически ставить знак вопроса к тому, что вы с давних пор считали не требующим доказательств (Бертран Рассел) ►Благодарности сюда◄
 
 
 
#5
19.02.2019 15:48:02
Казанский, большое спасибо. Еще один вопрос, а где тут можно указать диапазон, чтоб генерация была между 0 и числом указанной в ячейке В11?  
 
 
 
#6
19.02.2019 15:56:26
Сколько должно быть чисел и в каком интервале они должны изменяться?
в зависимости от этого можно предложить различные алгоритмы
один из вариантов: https://www.planetaexcel.ru/forum/index.php?PAGE_NAME=message&FID=1&TID=88987&MID=s

еще здесь есть: https://www.planetaexcel.ru/techniques/2/94/
Изменено: MCH - 19.02.2019 15:57:44
 
 
 
#7
19.02.2019 16:51:35
MCH, количество и интервал случайных чисел постоянно меняется в зависимости от выполняемой работы. Этот макрос нужен для создания шаблона, в шаблоне активны две ячейки, куда вносятся:
В11 - вносится верхняя граница интервала (нижняя граница по умолчанию 1)
В13 - вносится количество необходимых случайных чисел

сейчас есть код и он работает, но часто выдает повторяющиеся случайные числа. Например, из 311 шт случайных чисел (интервал между 0 и 5795), выдает 7 номеров которые идентичны.
вот код:
Код
Sub Randomnumber()
Dim Rand As Range
 Randomize
 For Each Rand In Range("D11").Resize(Range("B13").Value, 1)
 Rand = WorksheetFunction.RandBetween(1, Range("B11"))
 Next Rand
End Sub

Необходимо, чтоб не было идентичных номеров.  
 
 
 
#8
19.02.2019 16:53:53
Код такой же, как в первом сообщении? Зачем дублировать?
После Вашего кода размещен макрос Казанского, которому Вы обрадовались. Уже не нужен? Если нужен, зачем старый код?
 
 
 
#9
19.02.2019 17:18:44
задаете
В11 - верхняя граница диапазона случайных чисел
В13 - требуемое количество случайных чисел
этот макрос
Код
Sub RandB13FromB11()
  Columns(4).ClearContents:  If [b13] = 0 Or [b11] = 0 Or [b13] > [b11] Then Exit Sub
  [c1].Resize([b11], 1).Formula = "=rand()"
  [d1].Resize([b13], 1).FormulaR1C1 = "=rank(rc[-1],r1c3:r" & [b11] & "c3)"
  [d1].Resize([b13], 1).Value = [d1].Resize([b13], 1).Value: Columns(3).ClearContents
End Sub

сгенерирует требуемое количество случайных чисел в рамках указанного диапазона значений без повторений
Изменено: Ігор Гончаренко - 19.02.2019 18:15:54
Программисты - это люди, решающие проблемы, о существовании которых Вы не подозревали, методами, которых Вы не понимаете!
 
 
 
#10
19.02.2019 17:46:00
Цитата
said.makhmudov написал:
В силу необходимости использования этого генератора в работе, нужно чтоб он не создавал случайные числа, которые повторяются.
Должны ли числа быть целыми?
Обычно для создания перечня уникальных числовых значений я добавляю к целой части (значимой) дробную, сгенерированную на основании последовательности отличающихся друг от друга чисел (например, порядковый номер числа в последовательности деленный на заведомо большое число)
 
 
 
#11
19.02.2019 18:06:21
вариант
 
 
 
#12
19.02.2019 18:08:45
IKor, да числа должны быть целыми. В дальнейшем эти цифры будут использоваться для выборки определенных документов, буду выбирать по порядковому номеру документа исходя из сгенерированного номера
 
 
 
#13
19.02.2019 18:12:01
vikttur, с кодом Казанского я не разобрался, попробовал с ним поработать, у меня не получилось. Я сам не программист и новичок этого форума. Заранее извиняюсь, если нарушаю правила и этику форума.  
 
 
 
#14
19.02.2019 19:22:22
и еще в коллекцию ...
Код
Option Explicit

Sub poneslo_chislo()
    Dim chislo As Double, i As Long, kolvo As Long, niz As Long, ver As Long
    
    niz = 1                         'nizhnyy razmer
    ver = Range("b11").Value        'verkhniy razmer
    kolvo = Range("b13").Value      'kolichestvo
    
    i = Cells(Rows.Count, "d").End(xlUp).Row
    If i < 11 Then i = 11
    Range("d11:d" & i).ClearContents
    
    Randomize
    'Drugoy variant
    'Range("d11").Value = Int((ver - niz + 1) * Rnd + niz)
    
    'Drugoy variant
    'For i = 2 To kolvo
    For i = 1 To kolvo
        chislo = Int((ver - niz + 1) * Rnd + niz)
        Do Until TypeName(Application.Match(chislo, Range("d11:d" & i + 10), 0)) = "Error"
        'Drugoy variant
        'Do Until TypeName(Application.Match(chislo, Range("d11:d" & i + 10 - 1), 0)) = "Error"
            chislo = Int((ver - niz + 1) * Rnd + niz)
        Loop
        Range("d" & i + 10).Value = chislo
    Next
End Sub
 
 
 
#15
19.02.2019 19:42:06
MCH, Ваш код очень мне помог, шаблон создан. Огромное спасибо, успехов и всех благ.  
Цитата
RNDarr.xlsm  (15.68 КБ)
Остальным участникам тоже большая благодарность за содействие и помощь.  
 
 
 
Страницы: 1
Наверх