excel - 使用 VBA 的唯一随机数

Question

我正在尝试在用户定义的范围内创建一系列唯一(非重复)随机数。我已经设法创建随机数，但我得到了重复的值。如何确保随机数永远不会重复？

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" & 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 " & 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

Answer 1

这是保证唯一整数随机数的方法。内联注释描述了该方法。

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

注意:参见this Wikipedia article regarding shuffle bias

此次编辑修复了一个偏见来源。 Rnd(基于 32 位种子)和模偏差的固有局限性仍然存在。