我仍在努力掌握VBA。
我有以下代码,基本上生成一行彩票号码。 目前,它为我提供了来自1-49的5个随机数和来自1-10的2个随机数。
我需要它来使值唯一,即5个中没有一个可以重复,2个不能相同。
此外,如果我要在Cell“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
答案 0 :(得分: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