根据单元格值复制代码

我仍然试图去处理VBA。

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

我需要它使值独一无二，即5个中的任何一个都不能重复，2个不能相同。

此外，如果我要在单元格“A1”有多less行，你想在“E1”中input一个数字，我怎么能产生“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的项目中，并粘贴下面的代码。 这个想法是创build一个唯一值的数组，随机洗牌，然后遍历数组获取下一个随机值：

 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