Как написать код VBA мне, который отображает 10 случайных чисел от 1 до 50 без повторения чисел

Question

Как мне написать код VBA, который отображает 10 случайных чисел от 1 до 50 без повторения чисел?

Answer 1

В B1 - B50 введите:

 =RAND()

В А1 введите:

=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 .