Question

我试图随机分配B4范围内的单元格：Z23大小为20 X 25，即总共500个单元格应该包含总共500个唯一值，随机值的范围是1到500.因此每个数字只能出现一次桌子。尝试使用下面的代码，但它在某些单元格中生成重复项。

有人可以帮我吗？

.toString()

Answer 1

因此，此代码将检查生成的每个随机数，以查看它是否与生成的任何先前值相同。如果是这样，它会生成一个新的随机数，直到它是唯一的。

Option Explicit
Public Sub Random()

    Dim RandomNumber As Integer
    Dim i, j, k, l As Integer

    Application.ScreenUpdating = False

    For j = 2 To 26
        For i = 4 To 26
            With Sheets("Game")
                Randomize
                RandomNumber = Int(500 * Rnd + 1)
                ' Search through all previous rows & columns (not including the current one)
                For k = 2 To j - 1
                    For l = 4 To i - 1
                        'If the current number is the same as a previous one choose a new one
                        Do While RandomNumber = Cells(l, k)
                            RandomNumber = Int(500 * Rnd + 1)
                        Loop
                        'Once the number is unique place it in the cell
                        Cells(i, j) = RandomNumber
                    Next l
                Next k
            End With
        Next i
    Next j


End Sub

Answer 2

另外一种方法，但是使用字典检查重复值，使用模数运算符将它们放在正确的单元格中。

     Sub Random()
        Dim r As Integer, i As Integer, n As Integer, dict As Dictionary
        Set dict = New Dictionary
        While n < 525
            r = Int(525 * Rnd + 1)
            If Not dict.Exists(r) Then
                dict(r) = 0
                n = n + 1
                If (n Mod 25) = 0 Then i = i + 1
                Cells((i Mod 21) + 4, (n Mod 25) + 2) = r
            End If
        Wend
     End Sub

Answer 3

另一种字典方法，可根据初始范围动态调整

Option Explicit

Public Sub Random1()
    Dim ws As Worksheet, d As Object, max1 As Long, max2 As Long
    Dim i As Long, j As Long, k As Long, arr As Variant

    Set ws = ThisWorkbook.Worksheets("Game")

    arr = ws.Range("B4:Z23")    'adjusts based on this initial range

    max1 = UBound(arr, 1)
    max2 = UBound(arr, 2)

    k = max1 * max2             '<--- 500 (B4:Z23)

    Set d = CreateObject("Scripting.Dictionary")
    Do
        j = Int(((k + 1) * Rnd) + 1)    'Rnd returns a single (decimals)
        If Not d.exists(j) Then
            i = i + 1
            d(j) = i
        End If
    Loop While d.Count < k + 1

    For i = 0 To max1 - 1
        For j = 0 To max2 - 1
            arr(i + 1, j + 1) = d(k)
            k = k - 1
        Next
    Next

    ws.Range("B4:Z23") = arr

End Sub

使用VBA在单元格范围内生成真正的随机数

3 个答案: