使用 VBA 的唯一随机数 [英] Unique Random Numbers using VBA
本文介绍了使用 VBA 的唯一随机数的处理方法,对大家解决问题具有一定的参考价值,需要的朋友们下面随着小编来一起学习吧!
问题描述
我正在尝试在用户定义的范围内创建一系列唯一的(非重复的)随机数.我设法创建了随机数,但我得到了重复的值.如何确保随机数永远不会重复?
I am trying to create a series of unique (non-duplicating) random numbers within a user defined range. I have managed to create the random numbers, but I am getting duplicate values. How can I ensure that the random numbers will never be a duplicate?
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
推荐答案
这是一种保证唯一整数随机数的方法.内嵌注释描述了该方法.
Here's a method of guaranteeing unique integer random numbers. Inline comments describe the method.
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 位种子)和模偏差的固有限制仍然存在.
The edit fixed one source of bias. The inherent limitations of Rnd
(based on a 32 bit seed) and Modulo bias remain.
这篇关于使用 VBA 的唯一随机数的文章就介绍到这了,希望我们推荐的答案对大家有所帮助,也希望大家多多支持IT屋!
查看全文