在excel中生成一个1到100之间的一个随机数,在单击按钮时显示在给定单元格(例如A1)中,然后再次单击该按钮时,它将生成另一个随机数介于1到100之间,这不是重复。理想情况下,这应该允许我点击按钮100次并获得1-100之间的所有数字?
答案 0 :(得分:2)
从技术上讲,没有重复的随机数字。你要求的实际上是一组价值观的随机排列,比如一张洗牌的牌或彩票球的选择。可以在Excel VBA中简洁地实现一系列语言的随机排列。
将按钮的宏指定给RangeValue():
Public Sub RangeValue()
Dim i As Long
Static n As Long, s As String
Const MIN = 1, MAX = 100, OUT = "A1", DEL = "."
Randomize
Do
i = Rnd * (MAX - MIN) + MIN
If 0 = InStr(s, i & DEL) Then
n = n + 1: s = s & i & DEL
Range(OUT) = i
If n > MAX - MIN Then n = 0: s = ""
Exit Do
End If: DoEvents
Loop
End Sub
那就是它。上面的代码就是回答您提出的问题所需的全部内容。
您可以使用靠近顶部的Const
行来编辑将随机旋转的MIN和MAX值范围。您也可以调整输出单元格。
一旦输出了所有值(即100次按钮点击),代码将以新的随机顺序重新复位并再次旋转整个范围。这将持续下去。您可以通过删除以下行禁用多个旋转:If n > MAX - MIN Then n = 0: s = ""
这是如何运作的?
例程维护一串先前的输出值。每次运行该过程时,它都会从该范围中选择一个新的随机值,并检查该值是否已记录在该字符串中。如果是,它会选择一个新值并再次查看。这将循环继续,直到随机选择当前未记录在字符串中的值;记录该值并将其输出到单元格。
编辑#1
要解决有关如何设置此问题以使其在多个具有不同值范围的单元格中工作的新问题,请将按钮的宏指定给ButtonClick():
Public Sub ButtonClick()
Static n1 As Long, s1 As String, n2 As Long, s2 As String
RangeValue 1, 100, "A1", n1, s1
RangeValue 1, 150, "B1", n2, s2
End Sub
Private Sub RangeValue(MIN As Long, MAX As Long, OUT As String, n As Long, s As String)
Dim i As Long
Const DEL = "."
Randomize
Do
i = Rnd * (MAX - MIN) + MIN
If 0 = InStr(s, i & DEL) Then
n = n + 1: s = s & i & DEL
Range(OUT) = i
If n > MAX - MIN Then n = 0: s = ""
Exit Do
End If: DoEvents
Loop
End Sub
编辑#2
虽然上述方法简洁,但我们可以通过置换数组中的值集并避免选择已经输出的值来提高效率。这是使用Durstenfeld's implementation of the Fisher–Yates shuffle algorithm的版本:
Public Sub ButtonClick()
Static n As Long, a
Const MIN = 1, MAX = 100, OUT = "A1"
If n = 0 Then a = Evaluate("transpose(row(" & MIN & ":" & MAX & "))"): n = UBound(a)
PermuteArray a, n: Range(OUT) = a(n): n = n - 1
End Sub
Private Sub PermuteArray(a, n As Long)
Dim j As Long, t
Randomize
j = Rnd * (n - 1) + 1
If j <> n Then t = a(j): a(j) = a(n): a(n) = t
End Sub
Fisher-Yates的优势在于它可以根据需要停止和启动,因此我在运行中使用它来置换每个按钮点击时显示的下一个值。
使用一个版本来解决这个问题,以便使用两个使用不同值范围的输出单元格:
Public Sub ButtonClick()
Static n1 As Long, n2 As Long, a1, a2
Const MIN1 = 1, MAX1 = 100, OUT1 = "A1"
Const MIN2 = 1, MAX2 = 150, OUT2 = "B1"
If n1 = 0 Then Reset a1, n1, MIN1, MAX1
If n2 = 0 Then Reset a2, n2, MIN2, MAX2
PermuteArray a1, n1: Range(OUT1) = a1(n1): n1 = n1 - 1
PermuteArray a2, n2: Range(OUT2) = a2(n2): n2 = n2 - 1
End Sub
Private Sub PermuteArray(a, n As Long)
Dim j As Long, t
Randomize
j = Rnd * (n - 1) + 1
If j <> n Then t = a(j): a(j) = a(n): a(n) = t
End Sub
Private Sub Reset(a, n As Long, MIN As Long, MAX As Long)
a = Evaluate("transpose(row(" & MIN & ":" & MAX & "))"): n = UBound(a)
End Sub
编辑#3
我决定使用Fisher-Yates的"inside-out" variation创建一个版本。这允许我们指定范围值数组并同时对其进行随机播放,这是一种优雅且更有效的增强:
Public Sub ButtonClick()
Const MIN = 1, MAX = 100, OUT = "A1"
Static a, n&
If n = 0 Then Reset a, n, MIN, MAX
Range(OUT) = a(n): n = n - 1
End Sub
Private Sub Reset(a, n&, MIN&, MAX&)
Dim i&, j&
Randomize: n = MAX - MIN + 1: ReDim a(1 To n)
For i = 1 To n
j = Rnd * (i - 1) + 1: a(i) = a(j): a(j) = i - 1 + MIN
Next
End Sub
为了扩展您对两个不同输出单元的需求,每个输出单元使用不同的值范围,我决定制定一个通用的解决方案,可以用于任意数量的独立输出单元,每个单元都绑定到自己的值范围:
Public Sub ButtonClick()
Dim MIN, MAX, OUT, i
Static a, n, z
MIN = Array(1, 11, 200): MAX = Array(100, 20, 205): OUT = Array("A1", "B2", "C3")
z = UBound(MIN)
If Not IsArray(n) Then ReDim a(z): ReDim n(z)
For i = 0 To z
If n(i) = 0 Then Reset a(i), n(i), MIN(i), MAX(i)
Range(OUT(i)) = a(i)(n(i)): n(i) = n(i) - 1
Next
End Sub
Private Sub Reset(a, n, MIN, MAX)
Dim i, j
Randomize: n = MAX - MIN + 1: ReDim a(1 To n)
For i = 1 To n
j = Rnd * (i - 1) + 1: a(i) = a(j): a(j) = i - 1 + MIN
Next
End Sub
虽然以上设置为三个输出,但只需调整顶部附近的MIN,MAX和OUT阵列即可满足您的需求。
答案 1 :(得分:1)
这是一个按钮单击处理程序,它使用静态变量来保存包含1到100之间随机数字序列的数组,以及该数组中的当前位置/索引。通过使用1到100的数字填充集合来创建数组,然后以随机顺序将每个数字传输到数组。
Sub Button1_Click()
Static NumberArray As Variant
Static intIndex As Long
If Not IsArray(NumberArray) Then NumberArray = GetRandomArray()
' If we haven't reached the end of our sequence, get another number...
If intIndex < 100 Then
Sheets("Sheet1").Range("A1") = NumberArray(intIndex)
intIndex = intIndex + 1
End If
End Sub
Function GetRandomArray() As Variant
Dim c As New Collection
Dim a(99) As Long
' Seed the RNG...
Randomize
' Add each number to our collection...
Dim i As Long
For i = 1 To 100
c.Add i
Next
' Transfer the numbers (1-100) to an array in a random sequence...
Dim r As Long
For i = 0 To UBound(a)
r = Int(c.Count * Rnd) + 1 ' Get a random INDEX into the collection
a(i) = c(r) ' Transfer the number at that index
c.Remove r ' Remove the item from the collection
Next
GetRandomArray = a
End Function
答案 2 :(得分:0)
试试这个:
Dim Picks(1 To 100) As Variant
Dim which As Long
Sub Lah()
Dim A As Range
Set A = Range("A1")
If A.Value = "" Then
which = 1
For i = 1 To 100
Picks(i) = i
Next i
Call Shuffle(Picks)
Else
which = which + 1
If which = 101 Then which = 1
End If
A.Value = Picks(which)
End Sub
Sub Shuffle(InOut() As Variant)
Dim HowMany As Long, i As Long, J As Long
Dim tempF As Double, temp As Variant
Hi = UBound(InOut)
Low = LBound(InOut)
ReDim Helper(Low To Hi) As Double
Randomize
For i = Low To Hi
Helper(i) = Rnd
Next i
J = (Hi - Low + 1) \ 2
Do While J > 0
For i = Low To Hi - J
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = temp
End If
Next i
For i = Hi - J To Low Step -1
If Helper(i) > Helper(i + J) Then
tempF = Helper(i)
Helper(i) = Helper(i + J)
Helper(i + J) = tempF
temp = InOut(i)
InOut(i) = InOut(i + J)
InOut(i + J) = temp
End If
Next i
J = J \ 2
Loop
End Sub
修改#1 强>
代码首先检查目标单元格 A1 。如果单元格为空,则代码为:
如果单元格不为空,则代码只是将随机数组的下一个元素放在 A1 中。
如果要重新启动此过程,请清除 A1 。这将重新洗牌阵列。
答案 3 :(得分:0)
这是一种在A100以下的单元格中维护可用数字和地点#N / A的全局集合的方法。按钮的click()
子命令确保在需要时初始化集合。在标准代码模块(insert -> module
)中输入:
Public Available As Collection
Public Initialized As Boolean
Sub Initialize()
Dim i As Long, n As Long
Dim used(1 To 100) As Boolean
Set Available = New Collection
If Not Range("A1").Value < 1 Then
n = Cells(Rows.Count, 1).End(xlUp).Row()
For i = 1 To n
used(Cells(i, 1).Value) = True
Next i
End If
For i = 1 To 100
If Not used(i) Then Available.Add i
Next i
Initialized = True
End Sub
Function NextRand()
'assumes that Initialize() has been called
Dim i As Long, num As Long
i = Application.WorksheetFunction.RandBetween(1, Available.Count)
num = Available.Item(i)
Available.Remove i
NextRand = num
End Function
添加一个按钮,然后在其事件处理程序中添加代码,使其看起来像: (实际名称取决于按钮,如果是Active-X按钮,表单按钮或只是形状)
Private Sub CommandButton1_Click()
If (Not Initialized) Or Range("A1").Value < 1 Then Initialize
Dim i As Long, n As Long
If Range("A1").Value < 1 Then
Range("A1").Value = NextRand()
Exit Sub
End If
n = 1 + Cells(Rows.Count, 1).End(xlUp).Row()
If n > 100 Then
Cells(n, 1).Value = CVErr(xlErrNA)
Else
Cells(n, 1).Value = NextRand()
End If
End Sub
答案 4 :(得分:0)
考虑对100个随机数的列表进行排序并保持其初始索引。我有两个按钮(或标签),一个用于初始化列表,另一个用于显示下一个随机值
代码如下:
Const RandomCount As Long = 100
Private m_seq() As Variant ' Keep in memory the random numbers
Private m_current As Long ' Keep in memory the last shown number
Private Sub initializeLabel_Click()
Dim wk As Worksheet
Set wk = Worksheets.Add(Type:=xlWorksheet) 'add a worksheet
ReDim m_seq(1 To RandomCount, 1 To 2) 'Initialize a 2D array
Dim i As Long
For i = 1 To RandomCount
m_seq(i, 1) = i 'add values 1..100 to first column
m_seq(i, 2) = Rnd() 'add random numbers to second column
Next i
'Output the array into the new worksheet
wk.Range("A1").Resize(RandomCount, 2).Value2 = m_seq
' Sort the worksheet
wk.Range("A1").Resize(RandomCount, 2).Sort wk.Range("B1")
'Input the sorted values back into the array
m_seq = wk.Range("A1").Resize(RandomCount, 2).Value2
' Delete the worksheet quietly
Application.DisplayAlerts = False
wk.Range("A1").Resize(RandomCount, 2).ClearContents
wk.Delete
Application.DisplayAlerts = True
'Reset the UI
m_current = 0
[A1].ClearContents
End Sub
Private Sub randomLabel_Click()
m_current = m_current + 1
If m_current > RandomCount Then m_current = 1
[A1].Value2 = m_seq(m_current, 1)
End Sub
临时工作表中的值如下所示
并在排序后
其中使用了第一列