Блог

Я пытаюсь создать серию уникальных (не дублирующихся) случайных чисел в пределах определенного пользователем диапазона. Мне удалось создать случайные числа, но я получаю повторяющиеся значения. Как я могу гарантировать, что случайные числа никогда не будут дублироваться?

 Sub GenerateCodesUser()
    Application.ScreenUpdating = False
    Worksheets("Users").Activate

    Dim MINNUMBER As Long
    Dim MAXNUMBER As Long

    MINNUMBER = 1000
    MAXNUMBER = 9999999

    Dim Row As Integer
    Dim Number As Long
    Dim high As Double
    Dim Low As Double
    Dim i As Integer

    If (CustomCodes.CardNumberMin.Value = "") Then
        MsgBox ("Fill Card Number Field!")
        Exit Sub
    ElseIf (CustomCodes.CardNumberMin.Value < MINNUMBER) Then
        MsgBox ("Card Number Value must be equal or higher then" amp; MINNUMBER)
        Exit Sub
    End If

    If (CustomCodes.CardNumberMax.Value = "") Then
        MsgBox ("Fill Card Number Field!")
        Exit Sub
    ElseIf (CustomCodes.CardNumberMax.Value > MAXNUMBER) Then
        MsgBox ("Card Number Value must be equal or higher then " amp; MAXNUMBER)
        Exit Sub
    End If

    Low = CustomCodes.CardNumberMin.Value
    high = CustomCodes.CardNumberMax.Value '<<< CHANGE AS DESIRED

    If (Low < 1000) Then
        'break
    End If

    For i = 1 To Cells(1, 1).End(xlToRight).Column
        If InStr(Cells(1, i), "CardNumber") Then
            Row = 2
            While Cells(Row, 1) <> 0
                Do
                    Number = ((high - Low   1) * Rnd()   Low)
                Loop Until Number > Low
                Cells(Row, i) = Number
                Row = Row   1
            Wend
        End If
    Next

    Application.ScreenUpdating = True
End Sub
 

Вот способ гарантировать уникальные целочисленные случайные числа. Встроенные комментарии описывают метод.

 Function UniuqeRandom(Mn As Long, Mx As Long, Sample As Long) As Long()
    Dim dat() As Long
    Dim i As Long, j As Long
    Dim tmp As Long

    ' Input validation checks here
    If Mn > Mx Or Sample > (Mx - Mn   1) Then
        ' declare error to suit your needs
        Exit Function
    End If

    ' size array to hold all possible values
    ReDim dat(0 To Mx - Mn)

    ' Fill the array
    For i = 0 To UBound(dat)
        dat(i) = Mn   i
    Next

    ' Shuffle array, unbiased
    For i = UBound(dat) To 1 Step -1
        tmp = dat(i)
        j = Int((i   1) * Rnd)
        dat(i) = dat(j)
        dat(j) = tmp
    Next

    'original biased shuffle
    'For i = 0 To UBound(dat)
    '    tmp = dat(i)
    '    j = Int((Mx - Mn) * Rnd)
    '    dat(i) = dat(j)
    '    dat(j) = tmp
    'Next

    ' Return sample
    ReDim Preserve dat(0 To Sample - 1)
    UniuqeRandom = dat
End Function
 

используйте это так

 Dim low As Long, high As Long

Dim rng As Range
Dim dat() As Long

Set rng = Range(Cells(1, 1), Cells(1, 1).End(xlToRight))
dat = UniuqeRandom(low, high, rng.Columns.Count)
rng.Offset(1, 0) = dat
 

Примечание: смотрите Эту статью в Википедии о смещении в случайном порядке

Редактирование исправило один источник смещения. Присущие ограничения Rnd (на основе 32-битного начального числа) и смещения по модулю сохраняются.

Я вижу, что у вас есть принятый ответ, но, чего бы это ни стоило, вот мой ответ на этот вопрос. В этом используется логическая функция вместо числовых массивов. Это очень просто, но быстро. Преимущество этого, о котором я не говорю, что оно идеально, заключается в эффективном решении для чисел в большом диапазоне, потому что вы проверяете только те числа, которые вы уже выбрали и сохранили, и вам не нужен потенциально большой массив для хранения отклоненных вами значений, поэтому это не вызовет проблем с памятью из-заразмер массива.

 Sub UniqueRandomGenerator()
Dim N As Long, MaxNum As Long, MinNum As Long, Rand As Long, i As Long

MinNum = 1        'Put the input of minimum number here
MaxNum = 100      'Put the input of maximum number here
N = MaxNum - MinNum   1

ReDim Unique(1 To N, 1 To 1)

For i = 1 To N
Randomize         'I put this inside the loop to make sure of generating "good" random numbers
    Do
        Rand = Int(MinNum   N * Rnd)
        If IsUnique(Rand, Unique) Then Unique(i, 1) = Rand:  Exit Do
    Loop
Next
Sheet1.[A1].Resize(N) = Unique
End Sub

Function IsUnique(Num As Long, Data As Variant) As Boolean
Dim iFind As Long

On Error GoTo Unique
iFind = Application.WorksheetFunction.Match(Num, Data, 0)

If iFind > 0 Then IsUnique = False: Exit Function

Unique:
    IsUnique = True
End Function
 

Это работает отлично:

 Option Base 1
Public Function u(a As Variant, b As Variant) As Variant
 Application.Volatile
 Dim k%, p As Double, flag As Boolean, x() As Variant
    k = 1
  flag = False
  ReDim x(1)
   x(1) = Application.RandBetween(a, b)
  Do Until k = b - a   1

   Do While flag = False
   Randomize
    p = Application.RandBetween(a, b)
     'Debug.Assert p = 2
    resultado = Application.Match(p, x, False)
     If IsError(resultado) Then
      k = k   1
      ReDim Preserve x(k)
      x(k) = p
       flag = True
      Else
       flag = False
      End If
   Loop
   flag = False
  Loop
  u = x
End Function