vba - 根据单元格值复制代码

Question

我仍在努力掌握 VBA。

我有以下代码，它基本上生成一排彩票号码。
目前它为我提供了 1-49 的 5 个随机数和 1-10 的 2 个随机数。

我需要它来使值唯一，即 5 个不能重复，2 个不能彼此相同。

另外，如果我要在单元格“A1”中输入多少行，并在“E1”中输入一个数字，我如何生成“E1”中所述的行数？

Sub Lotto()
Application.ScreenUpdating = False
Dim I, choose, numbers(49) As Integer

Range("G2").Select
 For I = 1 To 49
  numbers(I) = I
 Next

Randomize Timer
 For I = 1 To 5
  choose = 1 + Application.Round(Rnd * (49 - I), 0)
   ActiveCell.Offset(0, I - 1).Value = numbers(choose)
    numbers(choose) = numbers(40 - I)
 Next

ActiveCell.Range("A2:N2").Select
Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:= _
xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:= _
xlLeftToRight
Range("a3").Select
ActiveCell.Select


Range("M2").Select
 For J = 1 To 10
  numbers(J) = J
 Next

Randomize Timer
 For J = 1 To 2
  choose = 1 + Application.Round(Rnd * (10 - J), 0)
  ActiveCell.Offset(0, J - 1).Value = numbers(choose)
  numbers(choose) = numbers(10 - J)
 Next

 ActiveCell.Range("M2:N2").Select
 Selection.Sort Key1:=ActiveCell, Order1:=xlAscending, Header:= _
 xlGuess, OrderCustom:=1, MatchCase:=True, Orientation:= _
 xlLeftToRight
 Range("a4").Select
 ActiveCell.Select


Application.ScreenUpdating = False
End Sub

Answer 1

向项目中添加一个名为 UniqueRand 的类，然后粘贴下面的代码。这个想法是创建一个唯一值数组，随机打乱它，然后遍历数组以获得下一个随机值:

Private mValues() As Integer
Private mPoolSize As Integer
Private mCurrIdx As Integer
Private mRecycle As Boolean

' reuse the same sequence if true
' reshuffle the order if false
Public Property Let Recycle(rec As Boolean)
    mRecycle = rec
End Property

' Set the size of the random number pool to 1 to Size
Public Property Let Size(sz As Integer)
    mPoolSize = sz
    ReDim mValues(sz)
    ShufflePool
End Property

' return the next random value from the pool
Public Property Get NextRand() As Integer
    NextRand = mValues(mCurrIdx)
    mCurrIdx = mCurrIdx + 1
    If mCurrIdx = mPoolSize Then
        mCurrIdx = 0
        If Not mRecycle Then
            ShufflePool
        End If
    End If
End Property

Private Sub Class_Initialize()
    mPoolSize = 0
    mCurrIdx = 0
    mRecycle = True
End Sub

' internal method to generate random ints from min to max
Private Function RandBetween(min As Integer, max As Integer) As Integer
    RandBetween = min + CInt(Rnd() * (max - min))
End Function

Private Sub ShufflePool()
    If mPoolSize = 0 Then
        Exit Sub
    End If

    For i = 0 To mPoolSize - 1
        mValues(i) = i + 1
    Next i

    ' swap values at randomly selected index
    Dim tmp
    For i = 0 To mPoolSize - 1
        Dim idx
        idx = RandBetween(1, mPoolSize)
        tmp = mValues(i)
        mValues(i) = mValues(idx)
        mValues(idx) = tmp
    Next i
End Sub

您可以为每个随机列表使用该类的单独实例。
关于如何从 E5 中的值填充行，只需引用 E5 并且单元格要直接填充:

Sub PopulateRow()

    Dim sheet As Worksheet
    Dim ur As UniqueRand
    Dim nValues As Integer
    Dim outputRow As Integer

    Set sheet = Application.ActiveSheet
    nValues = sheet.Cells.Range("E5").Value

    Set ur = New UniqueRand
    ur.Size = nValues

    outputRow = 6
    For Col = 1 To nValues
        sheet.Cells(outputRow, Col).Value = ur.NextRand
    Next Col

End Sub