none
Como fazer código VBA EXCEL gerar uma combinação dentro de outra (LOTOFÀCIL) RRS feed

  • Pergunta

  • Prezados,

    Com este código consegui gerar todas a combinações possíveis da Lotofácil, C(n, p) n=25 e P=15 que são 3.268.760, mas o jogo me permite fazer apostas com 16, 17 e 18 números, fazendo aposta com 16 números a probabilidade cai para 204.297.

    Pois bem, quando gero a planilha com 16 números o resultado das  combinações  e 2.042.975

    Isto é 10 vezes mais a probabilidade, para dar certo teria que combinar 16 por 15, da primeira combinação.

    Pergunto como consigo gerar este código para que eu tenha estas 204.297 combinações, e as outras de 17(24035) e 18(4.005) números. Estou desempregado e pretendo arriscar uma bolada, por isto e muito importante, agradeço a ajuda.

    ,Option Explicit

    'C(n, p) = n! / ((n-p)! * p!)
    'lPermutações a ser definido, seria o 'p' da fórmula acima
    Const lPermutações As Long = 15
    Dim r As Long
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim intGrupo As Integer
    Dim x As Byte 'apenas um contador para o laço
    Dim v(1 To 25)

    Sub Teste()
        Dim lElementos As Long

        'Popula vetor de elementos
        For x = 1 To 25    'coloquei em um laço pro código ficar mais limpo
            v(x) = CStr(x)
        Next x

        intGrupo = 0  'inicia o numero do grupo

        'C(n, p) = n! / ((n-p)! * p!)
        'lElementos seria o 'n' da fórmula acima
        lElementos = UBound(v) - LBound(v) + 1

        'Contador de linhas para uso no Excel:
        r = 0

        'Limpa Planilha ativa
        Cells.Delete

        'Inicia recursão:
        Combinação lElementos, lPermutações, 1
        'aqui salva o último wbk aberto após fazer todas as permutações    
        wkb.SaveAs ThisWorkbook.Path & "\perm" & intGrupo & ".xlsx"
        wkb.Close


    End Sub

    Sub Combinação(n As Long, p As Long, k As Long, Optional s As String)


        If p > n - k + 1 Then Exit Sub

        If p = 0 Then
            'Para visualizar o resultado de uma combinação no Excel:

            If r = 0 Then 'aqui se a linha for zero,
                Set wkb = Workbooks.Add
                Set wks = wkb.Sheets.Add 'adicionar uma nova guia
                intGrupo = intGrupo + 1  'incrementar o numero do grupo
                wks.Name = "grupo " & intGrupo  'renomear a guia pelo nome do grupo
            End If

            r = r + 1
            wks.Cells(r, "A").Resize(1, lPermutações) = Split(s, "|")
            'Se quiser visualizar o resultado na Janela de Verificação imediata, use:
            'Debug.Print s

            If r = 1000000 Then 'se a linha for igual a cem mil, salvar o wbk
                wkb.SaveAs ThisWorkbook.Path & "\perm" & intGrupo & ".xlsx"
                wkb.Close
                r = 0  'resetar o numero da linha
            End If

            Exit Sub

        End If

        'Recorre novamente:
        Combinação n, p - 1, k + 1, s & v(k) & "|"
        'Recorre novamente a partir do elemento anterior:
        Combinação n, p, k + 1, s

        End Sub

                                                                               
    sexta-feira, 6 de maio de 2016 02:41

Todas as Respostas

  • Prezados,

    Com este código consegui gerar todas a combinações possíveis da Lotofácil, C(n, p) n=25 e P=15 que são 3.268.760, mas o jogo me permite fazer apostas com 16, 17 e 18 números, fazendo aposta com 16 números a probabilidade cai para 204.297.

    Pois bem, quando gero a planilha com 16 números o resultado das  combinações  e 2.042.975

    Isto é 10 vezes mais a probabilidade, para dar certo teria que combinar 16 por 15, da primeira combinação.

    Pergunto como consigo gerar este código para que eu tenha estas 204.297 combinações, e as outras de 17(24035) e 18(4.005) números. Estou desempregado e pretendo arriscar uma bolada, por isto e muito importante, agradeço a ajuda.

    ,Option Explicit

    'C(n, p) = n! / ((n-p)! * p!)
    'lPermutações a ser definido, seria o 'p' da fórmula acima
    Const lPermutações As Long = 15
    Dim r As Long
    Dim wkb As Workbook
    Dim wks As Worksheet
    Dim intGrupo As Integer
    Dim x As Byte 'apenas um contador para o laço
    Dim v(1 To 25)

    Sub Teste()
        Dim lElementos As Long

        'Popula vetor de elementos
        For x = 1 To 25    'coloquei em um laço pro código ficar mais limpo
            v(x) = CStr(x)
        Next x

        intGrupo = 0  'inicia o numero do grupo

        'C(n, p) = n! / ((n-p)! * p!)
        'lElementos seria o 'n' da fórmula acima
        lElementos = UBound(v) - LBound(v) + 1

        'Contador de linhas para uso no Excel:
        r = 0

        'Limpa Planilha ativa
        Cells.Delete

        'Inicia recursão:
        Combinação lElementos, lPermutações, 1
        'aqui salva o último wbk aberto após fazer todas as permutações    
        wkb.SaveAs ThisWorkbook.Path & "\perm" & intGrupo & ".xlsx"
        wkb.Close


    End Sub

    Sub Combinação(n As Long, p As Long, k As Long, Optional s As String)


        If p > n - k + 1 Then Exit Sub

        If p = 0 Then
            'Para visualizar o resultado de uma combinação no Excel:

            If r = 0 Then 'aqui se a linha for zero,
                Set wkb = Workbooks.Add
                Set wks = wkb.Sheets.Add 'adicionar uma nova guia
                intGrupo = intGrupo + 1  'incrementar o numero do grupo
                wks.Name = "grupo " & intGrupo  'renomear a guia pelo nome do grupo
            End If

            r = r + 1
            wks.Cells(r, "A").Resize(1, lPermutações) = Split(s, "|")
            'Se quiser visualizar o resultado na Janela de Verificação imediata, use:
            'Debug.Print s

            If r = 1000000 Then 'se a linha for igual a cem mil, salvar o wbk
                wkb.SaveAs ThisWorkbook.Path & "\perm" & intGrupo & ".xlsx"
                wkb.Close
                r = 0  'resetar o numero da linha
            End If

            Exit Sub

        End If

        'Recorre novamente:
        Combinação n, p - 1, k + 1, s & v(k) & "|"
        'Recorre novamente a partir do elemento anterior:
        Combinação n, p, k + 1, s

        End Sub

                                                                               

    Amigo conseguiste solucionar esse problema? Se sim poderias me enviar o código corrigido. Abraços.

    quarta-feira, 12 de abril de 2017 15:05
  • O código está funcionado perfeitamente
    sexta-feira, 8 de dezembro de 2017 07:58
  • Basta alterar onde está escrito 15.

    A melhor forma de agradecer e votar como util e / ou marcar como resposta. Anderson Diniz diniabr2011@gmail.com

    domingo, 19 de julho de 2020 13:42
  • Código excelente.

    A quantidade de combinações é essa mesma, pois como são grupos de dezesseis dezenas (16 em 15) em cada sorteio nessa quantidade são gerados 10 cartões premiados com 15 pontos, por isso a probabilidade está correta também pois ela é a divisão por 10.

    Vejam os 15 cartões premiados nas 10 primeiras linhas (caso fossem sorteados de 1 a 15).

    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16            2.042.975 1
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 17   2
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 18   3
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 19   4
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 20   5
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 21   6
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 22   7
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 23   8
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 24   9
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 25   10
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 17   11
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 18   12
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 19   13
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 20   14
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 21   15
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 22   16
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 23   17
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 24   18
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 16 25   19
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 17 18   20
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 17 19   21
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 17 20   22
    1 2 3 4 5 6 7 8 9 10 11 12 13 14 17 21   23

    segunda-feira, 30 de novembro de 2020 01:06
  • Existe a possibilidade de fazer ele gerar as sequencias de números baseados em uma soma?

    Exemplo: Gerar 15 de 25 cuja soma destes 15 seja por exemplo 190.

    A soma pode ser de 120 a 280 - 160 possibilidades.

    dambrovski.wancley@hotmail.com

    terça-feira, 16 de março de 2021 17:06