Добрый день всем.
Задача состояла в том, чтобы в 3 столбца и 7 строк забить цифры от 1 до 7 случайным образом, с условием, что:
1. В строке не было повторяющихся чисел
2. Чтобы в разных строках не было по 2х одинаковым чисел
По сути, это рандомная жеребьевка 7ми команд при игре в круг (каждый с каждым) в день играет по 3 команды
Сразу предупрежу, что реализация "топорная", но все же работает. После запуска таблица выстраивается, но после 3-го запуска (именно 3-го) уходит в зацикл.
Подскажите в чем дело или что поправить
Задача состояла в том, чтобы в 3 столбца и 7 строк забить цифры от 1 до 7 случайным образом, с условием, что:
1. В строке не было повторяющихся чисел
2. Чтобы в разных строках не было по 2х одинаковым чисел
По сути, это рандомная жеребьевка 7ми команд при игре в круг (каждый с каждым) в день играет по 3 команды
| 7 | 5 | 6 |
| 5 | 1 | 4 |
| 2 | 4 | 6 |
| 6 | 1 | 3 |
| 1 | 2 | 7 |
| 5 | 2 | 3 |
| 3 | 4 | 7 |
Подскажите в чем дело или что поправить
| Код |
|---|
Sub AxeRND() Dim arr() Range(Cells(1, 1), Cells(20, 3)).ClearContents For i = 1 To 3 Return1: rDig = Int(Rnd * 7 + 1) Cells(1, i) = rDig If Cells(1, 1) <> "" And Cells(1, 2) <> "" And Cells(1, 3) <> "" Then If Cells(1, 1) = Cells(1, 2) Or Cells(1, 1) = Cells(1, 3) Or Cells(1, 2) = Cells(1, 3) Then GoTo Return1 End If End If Next For j = 2 To 7 'Randomize Return2: For i = 1 To 3 rDig = Int(Rnd * 7 + 1) LR = Cells(Rows.Count, 1).End(xlUp).Row Erase arr arr = Range(Cells(1, 1), Cells(LR + 1, 3)) Cells(j, i) = rDig If rDig = arr(j, 1) Or rDig = arr(j, 2) Or rDig = arr(j, 3) Then GoTo Return2 End If Next i For x = 1 To j - 1 If ((Cells(j, 1) = arr(x, 1) Or Cells(j, 1) = arr(x, 2) Or Cells(j, 1) = arr(x, 3)) And (Cells(j, 2) = arr(x, 1) Or Cells(j, 2) = arr(x, 2) Or Cells(j, 2) = arr(x, 3))) Or _ ((Cells(j, 1) = arr(x, 1) Or Cells(j, 1) = arr(x, 2) Or Cells(j, 1) = arr(x, 3)) And (Cells(j, 3) = arr(x, 1) Or Cells(j, 3) = arr(x, 2) Or Cells(j, 3) = arr(x, 3))) Or _ ((Cells(j, 2) = arr(x, 1) Or Cells(j, 2) = arr(x, 2) Or Cells(j, 2) = arr(x, 3)) And (Cells(j, 3) = arr(x, 1) Or Cells(j, 3) = arr(x, 2) Or Cells(j, 3) = arr(x, 3))) Then GoTo Return2 End If Next Next j End Sub |
