在VBA中没有重复的范围内的随机数

时间:2015-08-15 06:08:50

标签: excel vba excel-vba

在excel中生成一个1到100之间的一个随机数,在单击按钮时显示在给定单元格(例如A1)中,然后再次单击该按钮时,它将生成另一个随机数介于1到100之间,这不是重复。理想情况下,这应该允许我点击按钮100次并获得1-100之间的所有数字?

5 个答案:

答案 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 。如果单元格为空,则代码为:

  1. 创建一个包含100个值的数组
  2. 随机化该数组
  3. 初始化顺序计数器
  4. 将随机数组的第一个元素放在 A1
  5. 如果单元格不为空,则代码只是将随机数组的下一个元素放在 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个随机数的列表进行排序并保持其初始索引。我有两个按钮(或标签),一个用于初始化列表,另一个用于显示下一个随机值

screen

代码如下:

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

临时工作表中的值如下所示

work1

并在排序后

work2

其中使用了第一列