如何编写 VBA 代码来显示 1 到 50 之间的 10 个随机数，且这些数字不重复

Question

如何编写一个 VBA 代码，显示 1 到 50 之间的 10 个随机数，且这些数字不重复？

Answer 1

在B1通过B50进入：

 =RAND()

在A1进入：

=MATCH(LARGE(B:B,ROW()),B:B,0)

并复制A10：

只需编写一个简短的宏即可插入公式。如果您不想使用工作表方法，那么：

Sub WillNotRepeat()
   Dim ndex(1 To 50)
   For I = 1 To 50
      ndex(I) = I
   Next I

   Call Shuffle(ndex)

   For I = 1 To 10
      msg = msg & ndex(I) & vbCrLf
   Next I
   MsgBox msg
End Sub

Public Sub Shuffle(InOut() As Variant)
    Dim 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

Answer 2

使用 VBA：

Public Sub customRandom()
    Application.ScreenUpdating = False
    Dim wks As Worksheet
    Set wks = ActiveSheet
    wks.Rows.Clear
    totalNumbers = 10
    minValue = 1
    maxValue = 50
    firstRow = 1
    firstColumn = 1
    Randomize
    Dim results() As Integer
    ReDim results(totalNumbers)
    For i = 1 To totalNumbers
        randoming = True
        While randoming
            notfound = True
            a = Int(Rnd() * maxValue) + minValue
            For j = 1 To totalNumbers
                If a = results(j) Then
                    notfound = False
                    j = totalNumbers
                End If
            Next j
            If notfound = True Then
                results(i) = a
                randoming = False
                wks.Cells(firstRow, firstColumn) = a
                firstRow = firstRow + 1
            End If
        Wend
    Next i
    Application.ScreenUpdating = True
End Sub

它将填充细胞A1到A10，但可以使用变量firstRow和轻松更改firstColumn。