Дублирующий код на основе значения ячейки

Question

Я все еще пытаюсь справиться с VBA.

У меня есть следующий код, который по существу генерирует ряд номеров лотереи. В настоящее время он предоставляет мне 5 случайных чисел от 1-49 и 2 случайных числа от 1 до 10.

Мне нужно, чтобы значения были уникальными. Ни один из 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 

Вы можете использовать отдельный экземпляр класса для каждого случайного списка. касается как заполнить строки из значения в Е5, просто ссылка 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