找到你要的答案

Q:Random Number within a range without repetition in VBA [duplicate]

Q:随机数范围内无VBA [复制]重复

This question already has an answer here:

What would be the VBA code in excel to generate ONE random number between 1 to 100 that is displayed in a given cell (say A1) upon clicking a button, and then when the button is clicked again, it generates another random number between 1 to 100, THAT IS NOT A REPETITION. Ideally, this should allow me to click the button a 100 times and get all the numbers between 1-100 exactly once each ?

这个问题在这里已经有了答案:

什么是VBA代码在Excel中生成一个随机数1到100之间,在一个给定的细胞显示(比如A1)在点击一个按钮,然后单击按钮时,它产生了另一个随机数的1到100之间,这不是一个重复。理想情况下,应该允许我点击按钮100次,把所有的数字1-100之间每个一遍吗?

answer1: 回答1:

Technically there is no such thing as random numbers with no repetition. What you are asking for is actually a random permutation of a set of values, like the ordering of a shuffled deck of cards or lottery ball picks. Random permutation of a range of vlaues can be achieved in Excel VBA succinctly.

Assign your button's macro to 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

That's it. The above code is all that is required to answer your question as posed.

You can use the Const line near the top to edit the MIN and MAX range of values that will be spun through randomly. You can also adjust the OUTput cell.

Once all of the values have been output (i.e. 100 button clicks), the code resets and spins through the range again in a new, random order. This continues forever. You can disable multiple spins-through by deleting this line: If n > MAX - MIN Then n = 0: s = ""

How does this work?

The routine maintains a string of previously output values. Each time the procedure is run, it selects a new random value from the range and checks if that value is already logged in the string. If it is it picks a new value and looks again. This continues in a loop until a value not currently logged in the string is randomly selected; that value is logged and output to the cell.

EDIT #1

To address your new question about how to set this up so that it works in more than one cell with different value ranges, assign your button's macro to 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

EDIT #2

While the above methods are concise, we can be more efficient by permuting the set of values in an array, and by avoiding the selection of values that have already been output. Here is a version that uses 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 has the advantage that it can be stopped and started as needed and so I am using it on the fly to permute the next value to display on each button click.

And to round this out with a version to use with your scenario of two output cells that use different value ranges:

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

EDIT #3

I decided to create a version of this that utilizes the "inside-out" variation of Fisher–Yates. This allows us to specify the array of range values and shuffle it at the same time, an elegant and even more efficient enhancement:

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

And to expand on your requirement of two different output cells that each use different value ranges, I decided to craft a generalized solution that can be used for an arbitrary number of independent output cells each tied to its own value range:

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

While the above is setup for three outputs, simply adjust the MIN, MAX, and OUT arrays near the top to suit your needs.

技术上不存在没有重复的随机数。你问的实际上是一个随机排列的一组值,像一组卡片或彩票球选择排序。一系列值的随机排列可以简洁地实现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和最大范围的值,将通过随机旋转。您也可以调整输出单元。

一旦所有的值被输出(即100个按钮的点击),密码重置和旋转的范围又在一个新的,随机的顺序。这永远持续下去。您可以禁用多个旋转通过删除这一行:如果n >;最大-最小然后n = 0 =“”

这是怎么工作的?

该例程维护先前输出值的字符串。每次运行过程时,从范围中选择一个新的随机值,并检查该值是否已在字符串中记录。如果它是一个新的值,然后再看。这将继续在循环中,直到没有当前登录字符串中的值被随机选择,该值被记录并输出到单元格。

编辑# 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的实施的Fisher–耶茨洗牌算法:

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

费舍尔–雅茨的优势在于它可以停止和启动需要,所以我用它飞到下一个值来排列每个按钮上单击“显示。

用一个版本来循环使用这个版本,使用两个输出单元格的场景使用不同的值范围:

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

我决定创建一个版本,采用“由内而外”费舍尔–雅茨变异。这使我们能够指定数组的范围值和洗牌它在同一时间,一个优雅和更有效的增强:

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

虽然以上是三个输出设置,只需调整最小,最大,并在顶部附近的数组,以满足您的需求。

answer2: 回答2:

Here's a button click handler that uses static variables to hold an array containing a random sequence of numbers from 1 to 100, as well as the current position/index within that array. The array is created by populating a collection with numbers from 1 to 100, then transferring each number to the array in a random order.

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

这里是一个按钮单击处理程序,使用静态变量来保存一个数组,包含一个随机序列数从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
answer3: 回答3:

Try this:

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

EDIT#1

The code begins by examining the destination cell, A1. If the cell is empty the code:

  1. creates an array of 100 values
  2. randomizes that array
  3. initializes a sequential counter
  4. places the first element of the randomized array in A1

If the cell is not empty, the code just places the next element of the randomized array in A1.

If you want to restart the process, clear A1. This will re-shuffle the array.

试试这个:

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. creates an array of 100 values
  2. randomizes that array
  3. initializes a sequential counter
  4. places the first element of the randomized array in A1

如果单元格不为空,只是地方的随机数组A1的下一个元素。

如果你想启动过程,明确A1。这将重新洗牌数组。

answer4: 回答4:

Here is an approach that maintains a global collection of available numbers and places #N/A in cells below A100. The button's click() sub makes sure that the collection is initialized when it needs to be. In a standard code module (insert -> module) enter:

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

Add a button, then in its event handler add the code to make it look something like: (the actual name depends on the button and if it is an Active-X button, a forms button or just a shape)

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

这是一种方法,保持全球收集可用的数字和地方# N / A细胞低于100。按钮()子使集合初始化时需要。在一个标准的代码模块(插入- >;模块)输入:

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

Add a button, then in its event handler add the code to make it look something like: (the actual name depends on the button and if it is an Active-X button, a forms button or just a shape)

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
excel  vba  excel-vba