Поиск  Пользователи  Правила 
Закрыть
Логин:
Пароль:
Забыли свой пароль?
Регистрация
Войти
 
Страницы: 1
RSS
Как сгенерировать все возможные варианты комбинаций лотереи 5из36 в Ecxel?, сгенерировать все 376992 комбинации в одной таблице
 
Много искал по этому и другим форумам ответ на этот вопрос. Ничего вразумительного не нашел. Знаю, что эта тема тут была. Но хотелось бы получить внятный ответ как с помощью формул или VBA составить таблицу всех возможных комбинаций в лотерее 5 из 36. Известно что их 376992. Основное пожелание, нужно чтобы каждая цифра в комбинации размещалась в отдельной ячейке, а каждая комбинация в отдельной строчке.
Попутно хотелось бы решить эту же проблему и в лотерее 6 из 45. Там количество комбинаций значительно больше 8145060. Как известно строк в одной странице екселя чуть больше миллиона. Как тут с этим справиться?
Заранее огромное спасибо!  :)  
P.S. Не спрашивайте что же с таким количеством я буду делать  :)  )) Просто очень надо!!!
Изменено: Алексей - 28 Янв 2015 19:31:08
 
Цитата
Алексей пишет: очень надо
насколько именно? в тугриках, в смысле.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
вот, набросал кой-чего.
первое, что в голову пришло.
фрилансер Excel, VBA - контакты в профиле
"Совершенствоваться не обязательно. Выживание — дело добровольное." Э.Деминг
 
Здравствуйте
Набросал пример 5 из 36, но он такой корявенький. И ждать результата придётся год. Возможно кто-то подскажет как ускорить.
Изменено: CAHO - 28 Янв 2015 21:29:04
Никаких врагов, зато и никаких друзей.
 
такой вариант.
6Х45 придется подождать, пока выполнится.
Изменено: Михаил С. - 28 Янв 2015 21:31:35 (Подраправил файл)
 
маленькое изменение в макросе Kombinazii6_45:
Скрытый текст
 
Код генерации сочетаний под любые выборки писал давно, под 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
Изменено: MCH - 28 Янв 2015 22:26:49
 
Миш, я твой код и использовал.
Только под конкретные варианты.
 
Цитата
Михаил С. пишет: Миш, я твой код и использовал.
Михаил, у тебя не совсем корректная версия (возможно одна из первых), в ней нельзя сделать выборку 5 из 5 и т.п. (один единственный вариант).

PS:
Нашел тему, где опубликован код, который ты использовал: http://forum.msexcel.ru/index.php?topic=8452.0
Я его немного переписал
Изменено: MCH - 28 Янв 2015 23:40:27
 
Посмотрите, может это подойдет.В столбце А порядковые номера, Внизу статусбар.
Изменено: ValeryN - 28 Янв 2015 23:13:37 (ошибка)
 
Адаптировал свой код под вывод 6 из 45, вывод производится в несколько столбцов
Скрытый текст
 
[/USER][USER=52]ikki, Отличное решение! Никогда бы не подумал, что эту задачу можно решить используя всего одну функцию! Спасибо!
 
Михаил С., MCH,Отличный код получился и для 5из36 и для 6из45. А самое главное, считает очень быстро. Огромное спасибо!!!
Единственный вопрос, у меня получилось 8145039 комбинаций в 6из45 вместо 8145060, не хватает 21 комбинации. Можно как нибудь подправить? Брал файл ваш Михаил С.,
Еще раз спасибо!!!
 
Цитата
Алексей пишет: Единственный вопрос, у меня получилось 8145039 комбинаций в 6из45 вместо 8145060, не хватает 21 комбинации.
См. #6
Цитата
Михаил С. пишет: маленькое изменение в макросе Kombinazii6_45
udp. Ну, или вот файл
Изменено: Михаил С. - 29 Янв 2015 04:43:24 (Добавил файл.)
 
Вот мой скромный кодик. Справляется на моем ПК за 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 
Изменено: Все_просто - 29 Янв 2015 09:34:35
С уважением,
Федор/Все_просто
 
Цитата
Все_просто написал:
Вот мой скромный кодик. Справляется на моем ПК за 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

 
appolon44, на листе нет столько строк - 2324784, есть 1048576.
Формируйте 3 массива и записывайте их в соседние столбцы или на разные листы.
Изменено: Казанский - 30 Окт 2016 23:17:21
 
Спасибо!Казанский,
 
Цитата
Казанский написал:
Формируйте 3 массива и записывайте их в соседние столбцы или на разные листы.
Как это сделать?
 
ElmarB, например так
Код
Sub test()
Const ARR_SIZE& = 1000000 'высота массива на одном листе
Dim arr&(1 To ARR_SIZE, 1 To 6)
Dim n1&, n2&, n3&, n4&, n5&, n6&
Dim counter&, cntSh&

  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
              If counter = ARR_SIZE Then GoSub WriteArr
  Next: Next: Next: Next: Next: Next
  If counter Then GoSub WriteArr
  Exit Sub
WriteArr:
  cntSh = cntSh + 1
  Worksheets.Add(, ActiveSheet).Name = "MonkeyBusiness" & cntSh
  Range("A1").Resize(counter, 6).Value = arr
  counter = 0
Return
End Sub
 
И никто не обратил внимание, что решение нужно в другой программе - Ecxel :)
 
vikttur, однако гугл по запросу "ecxel" дает примерно примерно 232 000 ссылок, причем примерно 220 с Планеты: https://www.google.ru/search?q="ecxel"+site:www.planetaexcel.ru
А есть даже компьютерные курсы по этой мистической программе: http://proficlass.ru/?allevents=292  :)
Изменено: Казанский - 5 Ноя 2016 00:47:28
 
Цитата
Казанский написал:  ElmarB , например так
Благодарю)))
 
seo8, в третий раз учетка будет забанена.
Реклама, даже скрытая, запрещена!
 
Макрос из скинутых примеров пригодится))
Изменено: goodsanta - 21 Мар 2018 20:53:11
Страницы: 1
Читают тему (гостей: 1)