Много искал по этому и другим форумам ответ на этот вопрос. Ничего вразумительного не нашел. Знаю, что эта тема тут была. Но хотелось бы получить внятный ответ как с помощью формул или VBA составить таблицу всех возможных комбинаций в лотерее 5 из 36. Известно что их 376992. Основное пожелание, нужно чтобы каждая цифра в комбинации размещалась в отдельной ячейке, а каждая комбинация в отдельной строчке. Попутно хотелось бы решить эту же проблему и в лотерее 6 из 45. Там количество комбинаций значительно больше 8145060. Как известно строк в одной странице екселя чуть больше миллиона. Как тут с этим справиться? Заранее огромное спасибо! P.S. Не спрашивайте что же с таким количеством я буду делать )) Просто очень надо!!!
Мастерство программиста не в том, чтобы писать программы, работающие без ошибок. А в том, чтобы писать программы, работающие при любом количестве ошибок.
Sub Kombinazii6_45()
Dim a&(), i&, k&, n&, p&, j&, m&
n = 45: k = 6
ReDim a(1 To k)
Dim arr(1 To 814506, 1 To 6)
Application.ScreenUpdating = False
For i = 1 To k - 1
a(i) = i
Next i
a(k) = k - 1
UsedRange.ClearContents
For m = 0 To 9
Do
If a(k) = n Then p = p - 1 Else p = k
If p = 0 Then Exit Do
For i = k To p Step -1
a(i) = a(p) + i - p + 1
Next i
j = j + 1: If j > 814506 Then Exit Do
For i = 1 To k
arr(j, i) = a(i)
Next i
Loop
Cells(1, 1).Resize(814506, 6).Offset(0, 8 * m) = arr
Erase arr
j = 0
a(6) = a(6) - 1
Next
UsedRange.Columns.AutoFit
Application.ScreenUpdating = True
End Sub
Код генерации сочетаний под любые выборки писал давно, под 6 из 49 не адаптирован (Михаил С. это уже сделал):
Код
Sub MyCombin()
Dim a&(), i&, j&, m&, n&, p&
n = Val(InputBox("n =", , 10))
m = Val(InputBox("m =", , 3))
If n < m Or m < 1 Then Exit Sub
ReDim a&(1 To m), b&(1 To WorksheetFunction.Combin(n, m), 1 To m)
For i = 1 To m: a(i) = i: Next i
If m = n Then p = 1 Else p = m
Range("a1").CurrentRegion.ClearContents
Do
j = j + 1
For i = 1 To m: b(j, i) = a(i): Next i
If a(m) = n Then p = p - 1 Else p = m
If p Then
For i = m To p Step -1
a(i) = a(p) + i - p + 1
Next i
End If
Loop While p
[a1].Resize(UBound(b), m) = b
End Sub
Адаптировал свой код под вывод 6 из 45, вывод производится в несколько столбцов
Скрытый текст
Код
Sub MyCombin()
Dim a&(), i&, j&, m&, n&, p&, nRows&, rws&, clm&, nCombin&
n = Val(InputBox("n =", , 10))
m = Val(InputBox("m =", , 3))
If n < m Or m < 1 Then Exit Sub
nRows = Rows.Count 'количество строк на листе
nCombin = WorksheetFunction.Combin(n, m) 'количество возможных сочетаний
ReDim a&(1 To m), b&(1 To IIf(nCombin > nRows, nRows, nCombin), 1 To m)
For i = 1 To m: a(i) = i: Next i
If m = n Then p = 1 Else p = m
Cells.ClearContents
Do
j = j + 1
For i = 1 To m: b(j, i) = a(i): Next i
If j = nRows Or j + rws = nCombin Then
[a1].Offset(, clm).Resize(UBound(b), m) = b
j = 0
clm = clm + m + 1
rws = rws + nRows
If rws < nCombin Then ReDim b&(1 To IIf(nCombin - rws > nRows, nRows, nCombin - rws), 1 To m)
End If
If a(m) = n Then p = p - 1 Else p = m
If p Then
For i = m To p Step -1
a(i) = a(p) + i - p + 1
Next i
End If
Loop While p
End Sub
Михаил С., MCH,Отличный код получился и для 5из36 и для 6из45. А самое главное, считает очень быстро. Огромное спасибо!!! Единственный вопрос, у меня получилось 8145039 комбинаций в 6из45 вместо 8145060, не хватает 21 комбинации. Можно как нибудь подправить? Брал файл ваш Михаил С., Еще раз спасибо!!!
Вот мой скромный кодик. Справляется на моем ПК за 6 секунд. Превратить в 6 из 45 несложно. Надо добавить еще один цикл и поменять объявленную переменную arr.
Код
Sub test()
Dim arr&(1 To 376992, 1 To 5)
Dim n1&, n2&, n3&, n4&, n5&
Dim counter&
For n1 = 1 To 36
For n2 = n1 + 1 To 36
For n3 = n2 + 1 To 36
For n4 = n3 + 1 To 36
For n5 = n4 + 1 To 36
counter = counter + 1
arr(counter, 1) = n1
arr(counter, 2) = n2
arr(counter, 3) = n3
arr(counter, 4) = n4
arr(counter, 5) = n5
Next: Next: Next: Next: Next
Range("A1").Resize(counter, 5).Value = arr
End Sub
Все_просто написал: Вот мой скромный кодик. Справляется на моем ПК за 6 секунд. Превратить в 6 из 45 несложно. Надо добавить еще один цикл и поменять объявленную переменную arr.
Доброго времени суток всем! Попробовал переделать на 6 из 37 выдает ошибку: Run-time error '1004 Где ошибка, понять не могу?
Код
Sub test()
Dim arr&(1 To 2324784, 1 To 6)
Dim n1&, n2&, n3&, n4&, n5&, n6&
Dim counter&
For n1 = 1 To 37
For n2 = n1 + 1 To 37
For n3 = n2 + 1 To 37
For n4 = n3 + 1 To 37
For n5 = n4 + 1 To 37
For n6 = n5 + 1 To 37
counter = counter + 1
arr(counter, 1) = n1
arr(counter, 2) = n2
arr(counter, 3) = n3
arr(counter, 4) = n4
arr(counter, 5) = n5
arr(counter, 6) = n6
Next: Next: Next: Next: Next: Next
Range("A1").Resize(counter, 6).Value = arr
End Sub
Всем привет можно попросить помощи хачу попробовать сделать такуюже прогу на любую и из лотерей в одном возможно ли это сделать в принципе тоесть чтобы там были все игры начиная от рапидо 12-24 дуэль и 5 36 соответственно Хателось в приоретете для начала сделать прогу для игры 4-20 по одной из их взятой комбинации и слегка её изменить и только потом генерировать
как всё у вас просто и красиво! но.... как быть, если необходимо усложнить задачу: например, составить комбинации из списка чисел (числа в списке не повторяются)