[Métodos De Apostar (5)]

FAIXAS ARBITRÁRIAS

Uma variante do método anterior: pode-se estabelecer uma quantidade maior de faixas de distribuição, sete por exemplo. Em lugar de calcular a média, acham-se a maior e a menor contagem em cada sorteio, divide-se esse intervalo em sete faixas iguais e distribuem-se as dezenas pelas mesmas. O resto é igual.

' OBS.1: jogo estudado - Mega Sena

' OBS.2: foi feita a colagem na planilha, apenas das 6 colunas que interessam (dezenas)

Type tCnt

    Dez As Integer

    Cnt As Integer

End Type

Dim d(1 To 60) As tCnt ' dezenas

 

Type tCfg

    Img As String

    Cnt As Integer

End Type

Dim c(1 To 924) As tCfg ' configs

 

Type tFxa

    Lim As Integer

    Cnt As Integer

    Fin As String

End Type

Dim f(1 To 8) As tFxa ' faixas

 

Sub Main()

Dim x, prijogo, ultjogo As Integer

    ultjogo = ActiveCell.SpecialCells(xlLastCell).Row

    For x = 1 To 16

        prijogo = Worksheets(1).Cells(x, 9).Value

        Call CriaJogo(x, prijogo, ultjogo)

    Next x

End Sub

 

Sub CriaJogo(ByVal ppj As Integer, ByVal pj As Integer, uj As Integer)

 

Dim w, x, y, z As Integer

Dim f1, f2, f3, f4, f5, f6, f7 As Integer

 

' inicializar

' dezenas

For x = 1 To 60

    d(x).Dez = x

    d(x).Cnt = 0

    'd(x).Fxa = 0

Next x

' configs

z = 0

For f1 = 0 To 6

For f2 = 0 To 6

For f3 = 0 To 6

For f4 = 0 To 6

For f5 = 0 To 6

For f6 = 0 To 6

For f7 = 0 To 6

    ' so config validas

    If f1 + f2 + f3 + f4 + f5 + f6 + f7 = 6 Then

        z = z + 1

        c(z).Img = f1 & "," & f2 & "," & _

                    f3 & "," & f4 & "," & _

                    f5 & "," & f6 & "," & f7

        c(z).Cnt = 0

    End If

Next f7: Next f6: Next f5

Next f4: Next f3: Next f2: Next f1

 

Dim j(1 To 6) As Integer

Dim gap As Integer

Dim cfg As String

 

For x = pj To uj

    ' obter as dezenas

    For y = 1 To 6

        j(y) = Worksheets(1).Cells(x, y).Value

    Next y

   

    ' calc interv das faixas

    f(1).Lim = 9999

    f(8).Lim = -1

    For y = 1 To 60

        If f(8).Lim < d(y).Cnt Then f(8).Lim = d(y).Cnt

        If f(1).Lim > d(y).Cnt Then f(1).Lim = d(y).Cnt

    Next y

    z = (f(8).Lim - f(1).Lim)

    gap = DivPor7(z)

    If gap > 0 Then

        ' distrib as dezenas ANTES da contagem

        For y = 1 To 7

            If y > 1 And y < 6 Then f(y).Lim = f(y - 1).Lim + gap

            f(y).Cnt = 0

            f(y).Fin = Space(0)

        Next y

        f(8).Lim = f(8).Lim + 1

        For y = 1 To 6

            w = j(y)

            For z = 1 To 7

                If d(w).Cnt >= f(z).Lim And d(w).Cnt < f(z + 1).Lim Then

                    f(z).Cnt = f(z).Cnt + 1

                    Exit For

                End If

            Next z

        Next y

       

        ' desenhar a config

        cfg = Space(0)

        For y = 1 To 7

            cfg = cfg & f(y).Cnt

            If y < 7 Then cfg = cfg & ","

        Next y

       

        ' contar a config

        For y = 1 To 924

            If cfg = c(y).Img Then

                c(y).Cnt = c(y).Cnt + 1

                Exit For

            End If

        Next y

    End If

 

    ' contar as dezenas

    For y = 1 To 6

        w = j(y)

        d(w).Cnt = d(w).Cnt + 1

    Next y

Next x

   

' distrib final de todas as dez

For x = 1 To 60

    For y = 1 To 7

        If d(x).Cnt >= f(y).Lim And d(x).Cnt < f(y + 1).Lim Then

            'd(x).Fxa = y

            f(y).Fin = f(y).Fin & d(x).Dez & ","

            Exit For

        End If

    Next y

Next x

 

' exibir a distrib final

For x = 1 To 7

    cfg = f(x).Fin

    z = Len(cfg)

    ' elim ult virg

    If z > 0 Then f(x).Fin = Left(cfg, z - 1)

    Worksheets(1).Cells(ppj, x + 9).Value = f(x).Fin

Next x

 

' ordenar as config

Dim aux As tCfg

For x = 1 To 923

    For y = (x + 1) To 924

        If c(x).Cnt < c(y).Cnt Then

            aux = c(x)

            c(x) = c(y)

            c(y) = aux

        End If

    Next y

Next x

 

' exibir só as melhores config

For x = 1 To 9999

    Worksheets(1).Cells(ppj + 17, x + 9).Value = c(x).Img

    If c(x).Cnt < c(1).Cnt Then Exit For

Next x

Columns("J:P").EntireColumn.AutoFit

   

End Sub

 

Function DivPor7(ByVal n As Integer) As Integer

    ' mais prox interv div por 7

    Dim x As Integer

    For x = 0 To 6

        If (n + x) Mod 7 = 0 Then

            n = n + x

            Exit For

        ElseIf (n - x) > 0 And (n - x) Mod 7 = 0 Then

            n = n - x

            Exit For

        End If

    Next x

    DivPor7 = n \ 7

End Function

 

[Métodos De Apostar (4)]

FAIXAS ACIMA, ABAIXO E NA MÉDIA

Baseia-se na constatação de que não saem sempre as dezenas mais freqüentes, mas sim uma mistura de situações. Funciona assim: em cada sorteio, antes de contar as dezenas, determinar a média das contagens até o momento, separar as contagens em 3 faixas: na média, abaixo e acima da média. Encaixar as dezenas do sorteio na faixa onde se encontram (por exemplo, se for a MegaSena, 2 acima, 1 na média e 3 abaixo), formando assim uma combinação  (2-1-3 no exemplo) que deve ser contada, juntamente com as dezenas. Antes de ler o próximo sorteio, não esquecer de incluir as dezenas do atual na contagem, porque a formação da combinação é feita antes de se contar as dezenas.

Para não incluir resultados irreais, só começar a contar as combinações formadas após todas as dezenas haverem saído ao menos uma vez.

No fim dos resultados, distribuir todas as dezenas conforme a faixa e apostar na combinação mais freqüente. São possíveis varias apostas. (Continuando com a combinação 2-1-3 do exemplo, pegar 2 das dezenas com contagem acima da média, uma bem na média e três abaixo.) Com relação às dezenas acima e abaixo, podem-se apostar as mais próximas da média, as mais distantes, etc.

' OBS.1: jogo estudado – MegaSena

' OBS.2: já foi feita a colagem na planilha,

         usando Dados/De Texto e ignorando outras colunas que não as Dezenas

 

Type tCnt

    Dez As Integer

    Cnt As Integer

    'Fxa As Integer ' usada apenas no debug

End Type

Dim d(1 To 60) As tCnt ' dezenas

 

Type tCfg

    Img As String

    Cnt As Integer

End Type

Dim c(1 To 28) As tCfg ' configs

 

Type tFxa

    Cnt As Integer

    Fin As String

End Type

Dim f(1 To 3) As tFxa

 

Sub Main()

Dim x, prijogo, ultjogo As Integer

    ultjogo = ActiveCell.SpecialCells(xlLastCell).Row

    For x = 1 To 16

        prijogo = Worksheets(1).Cells(x, 9).Value

        If IsEmpty(prijogo) Then

            prijogo = 1

        Else

            prijogo = CInt(prijogo)

        End If

        Call CriaJogo(x, prijogo, ultjogo)

    Next x

End Sub

 

Sub CriaJogo(ByVal ppj As Integer, ByVal pj As Integer, uj As Integer)

Dim w, x, y, z As Integer

Dim f1, f2, f3 As Integer

 

' inicializar

' dezenas

For x = 1 To 60

    d(x).Dez = x

    d(x).Cnt = 0

    'd(x).Fxa = 0

Next x

' configs

z = 0

For f1 = 0 To 6

For f2 = 0 To 6

For f3 = 0 To 6

    ' só config válidas

    If f1 + f2 + f3 = 6 Then

        z = z + 1

        c(z).Img = f1 & "," & f2 & "," & f3

        c(z).Cnt = 0

    End If

Next f3: Next f2: Next f1

 

Dim j(1 To 6) As Integer

Dim cfg As String

 

For x = pj To uj

    ' obter as dezenas

    For y = 1 To 6

        j(y) = Worksheets(1).Cells(x, y).Value

    Next y

   

    ' calc interv das faixas

    z = 0

    For y = 1 To 60

        z = z + d(y).Cnt

    Next y

    z = z \ 60

    ' distrib as dezenas ANTES da contagem

    For y = 1 To 6

        w = j(y)

        If d(w).Cnt < z Then

            f(1).Cnt = f(1).Cnt + 1

        ElseIf d(w).Cnt > z Then

            f(3).Cnt = f(3).Cnt + 1

        Else

            f(2).Cnt = f(2).Cnt + 1

        End If

    Next y

   

    ' desenhar a config

    cfg = Space(0)

    For y = 1 To 3

        cfg = cfg & f(y).Cnt

        If y < 3 Then cfg = cfg & ","

    Next y

   

    ' contar a config

    For y = 1 To 28

        If cfg = c(y).Img Then

            c(y).Cnt = c(y).Cnt + 1

            Exit For

        End If

    Next y

 

    ' contar as dezenas

    For y = 1 To 6

        w = j(y)

        d(w).Cnt = d(w).Cnt + 1

    Next y

Next x

   

' distrib final de todas as dezs

For x = 1 To 60

    If d(x).Cnt < mda Then

        f(1).Fin = f(1).Fin & x & ","

    ElseIf d(x).Cnt > mda Then

        f(3).Fin = f(3).Fin & x & ","

    Else

        f(2).Fin = f(2).Fin & x & ","

    End If

Next x

 

' exibir a distrib final

For x = 1 To 3

    cfg = f(x).Fin

    z = Len(cfg)

    ' elim ult virg

    If z > 0 Then f(x).Fin = Left(cfg, z - 1)

    Worksheets(1).Cells(ppj, x + 9).Value = f(x).Fin

Next x

 

' ordenar as config

Dim aux As tCfg

For x = 1 To 27

    For y = (x + 1) To 28

        If c(x).Cnt < c(y).Cnt Then

            aux = c(x)

            c(x) = c(y)

            c(y) = aux

        End If

    Next y

Next x

 

' exibir so as melhores config

For x = 1 To 28

    Worksheets(1).Cells(ppj + 17, x + 9).Value = c(x).Img

    If c(x).Cnt < c(1).Cnt Then Exit For

Next x

Columns("J:P").EntireColumn.AutoFit

MsgBox “O.K.”

 

End Sub

 

'Sub lixo() 'saber qtd de cfg validas p/ inicializar array

'Dim x, f1, f2, f3 As Integer

'    z = 0

'    For f1 = 0 To 6

'    For f2 = 0 To 6

'    For f3 = 0 To 6

'        If f1 + f2 + f3 = 6 Then z = z + 1

'    Next f3: Next f2: Next f1

'    MsgBox (z)

'End Sub

[Métodos De Apostar (3)]

COMBINAÇOES POR LINHA DO ESQUEMA

Digo linhas do esquema, para diferenciar das linhas do arquivo de resultados, que são os sorteios.

Aqui vamos usar a Loto Fácil. Imaginar o volante como uma matriz de cinco linhas com cinco dezenas cada linha. Essas linhas, inicializadas como Strings de cinco espaços (Chr 32 ou 20h), recebem um asterisco na posição correspondente a cada dezena sorteada: forma-se assim, por linha, uma combinação que pode ser contada. Há duas possibilidades de fazer a contagem (variantes do método, que darão resultados diferentes, claro):  GERAL, que dá uma estatística das combinações mais freqüentes em geral; ou POR LINHA, o que dá um detalhamento por linha. (Dica: em lugar de espaços e asteriscos, pode-se usar “0”s e “1”s, cada combinação se tornando um binário, que pode ser convertido para um decimal entre 0 e 31 que dá o próprio índice da matriz de contagem.) Ao final da contagem, formar seqüências de cinco combinações em que haja exatamente quinze dezenas assinaladas com asteriscos ou “1”s.

 

' OBS.1: jogo estudado – Loto Facil

' OBS.2: já foi feita a colagem na planilha,

         usando Dados/De Texto e ignorando outras colunas que não as Dezenas

‘ OBS.3: tb é gerado um arquivo de saída: "Jogos-LF-aaaa-mm-dd.txt"

 

Type tCmb

    Img As String

    Cnt As Integer

End Type

Dim Cmb(1 To 5, 0 To 31) As tCmb

 

Sub Main()

    Dim x, jogo, n, ln As Integer

    Dim p1, p2, p3, p4, p5 As Integer

    Dim ult As Long

    Dim c, s As String

   

    ' inicialização

    Columns("R:T").ClearContents

    Columns("W:W").ClearContents

    For p1 = 0 To 1

    For p2 = 0 To 1

    For p3 = 0 To 1

    For p4 = 0 To 1

    For p5 = 0 To 1

    For x = 1 To 5

        s = p1 & p2 & p3 & p4 & p5

        n = BinToDec(s)

        Cmb(x, n).Img = s

        Cmb(x, n).Cnt = 0

    Next x

    Next p5

    Next p4

    Next p3

    Next p2

    Next p1

   

    ' contagem das combin

    ult = UltLin

    For jogo = 1 To ult

        s = String(25, "0")

        For x = 1 To 15

            n = Cel(jogo, x)

            Mid(s, n, 1) = "1"

        Next x

        For x = 1 To 25 Step 5

            c = Mid(s, x, 5)

            Select Case x

                Case 1

                    Call Contar(1, c, Cmb)

                Case 6

                    Call Contar(2, c, Cmb)

                Case 11

                    Call Contar(3, c, Cmb)

                Case 16

                    Call Contar(4, c, Cmb)

                Case 21

                    Call Contar(5, c, Cmb)

            End Select

        Next x

    Next jogo

   

    Call Ordenar(Cmb())

   

    ' exibir as combin contadas

    ln = 0

    For x = 1 To 5

        For n = 0 To 31

            ln = ln + 1

            Worksheets(1).Cells(ln, 18).Value = x

            Worksheets(1).Cells(ln, 19).Value = Cmb(x, n).Img

            Worksheets(1).Cells(ln, 19).NumberFormat = "00000"

            Worksheets(1).Cells(ln, 20).Value = Cmb(x, n).Cnt

        Next n

    Next x

   

    ' exibir os melhores jogos feitos

    Call Exibir(Cmb())

End Sub

 

Sub Contar(ByVal linha As Integer, ByVal comb As String, ByRef a() As tCmb)

    Dim x As Integer

    For x = 0 To 31

        If comb = a(linha, x).Img Then

            a(linha, x).Cnt = a(linha, x).Cnt + 1

            Exit Sub

        End If

    Next x

End Sub

 

Sub Ordenar(ByRef a() As tCmb)

    ' ordenar mantendo o grup por linha

    Dim linha, x, y As Integer

    Dim aux As tCmb

    For linha = 1 To 5

        For x = 0 To 30

            For y = (x + 1) To 31

                If a(linha, x).Cnt < a(linha, y).Cnt Then

                        aux = a(linha, x)

                        a(linha, x) = a(linha, y)

                        a(linha, y) = aux

                End If

            Next y

        Next x

    Next linha

End Sub

 

Sub Exibir(ByRef a() As tCmb)

    Dim linha As Long

    Dim p1, p2, p3, p4, p5 As Integer

    Dim m(1 To 5) As Integer

    Dim x, n As Integer

    Dim r, s As String

   

    For x = 1 To 5

        ' contagem media da linha

        m(x) = WorksheetFunction.Average( _

                    a(x, 0).Cnt, a(x, 31).Cnt)

        n = 0

        ' pos no array da menor contagem usada

        Do While a(x, n).Cnt > m(x)

            n = n + 1

        Loop

        m(x) = n

    Next x

   

    s = "Jogos-LF-" & Format(Date, "yyyy-mm-dd") & ".txt"

    Open s For Output As #1

   

    linha = 0

    For p1 = 0 To m(1)

    For p2 = 0 To m(2)

    For p3 = 0 To m(3)

    For p4 = 0 To m(4)

    For p5 = 0 To m(5)

    'For x = 1 To 5

        's = a(x, p1).Img & a(x, p2).Img & a(x, p3).Img & _

        '    a(x, p4).Img & a(x, p5).Img

        s = a(1, p1).Img & a(2, p2).Img & a(3, p3).Img & _

            a(4, p4).Img & a(5, p5).Img

        If Com15(s) Then

            linha = linha + 1

            r = Space(0)

            For n = 1 To 25

                If Mid(s, n, 1) = "1" Then r = r & n & ","

            Next n

            r = Mid(r, 1, Len® - 1)

            If linha <= 500 Then _

                Worksheets(1).Cells(linha, 23).Value = r

            Print #1, r

        End If

    'Next x

    Next p5

    Next p4

    Next p3

    Next p2

    Next p1

   

    Close (1)

End Sub

 

Function Cel(ByVal Lin As Integer, ByVal col As Integer) As Integer

    Cel = Worksheets(1).Cells(Lin, col).Value

End Function

 

Function UltLin() As Long

    'UltLin = ActiveCell.SpecialCells(xlLastCell).Row

    Dim x As Long

    Dim v As Integer

    For x = 1 To 9999

        v = Cel(x, 1)

        If v = 0 Then

            UltLin = x - 1

            Exit Function

        End If

    Next x

End Function

 

Function Com15(ByVal comb As String) As Boolean

    Dim x, t As Integer

    t = 0

    For x = 1 To 25

        If Mid(comb, x, 1) = "1" Then t = t + 1

    Next x

    If t = 15 Then

        Com15 = True

    Else

        Com15 = False

    End If

End Function

 

Function BinToDec(ByVal b As String) As Integer

    Dim x, n, p As Integer

    n = 0

    p = 16

    Do While Len( < 5

        b = "0" & b

    Loop

    For x = 1 To 5

        If Mid(b, x, 1) = "1" Then n = n + p

        p = p \ 2

    Next x

    BinToDec = n

End Function

 

[Métodos De Apostar (2)]

PARES ANTES-DEPOIS

O segundo método é contar quantas vezes cada dezena foi sorteada depois da anterior, isto é, contar os pares constituídos de atual/seguinte, em cada sorteio, exceto claro, a ultima dezena que não tem seguimento. Tomando por exemplo a Quina, computar em cada sorteio: 1ª/2ª, 2ª/3ª, 3ª/4ª e 4ª/5ª. Dá para notar que é preciso um arquivo por ordem de sorteio.

Ao final, iniciar a aposta pelo par que mais saiu, seguido pelo par iniciado pela 2ª dezena do anterior, e assim ir unindo os pares como num dominó. Mas pode acontecer que, em um novo par acrescentado à seqüência, se repita uma dezena que já está na seqüencia – nesse caso, pegar o próximo para que inicie pela mesma dezena anterior.

' OBS.1: jogo estudado - Quina

' OBS.2: este exemplo dá uma facilidade adicional:

         pode-se indicar na 9ª coluna ("I") o 1º sorteio a partir do qual será feita a contagem

         (os anteriores são ignorados); o valor default é 1

 

Type tPar

    d1 As Integer

    d2 As Integer

    cnt As Integer

End Type

Dim Par(1 To 80, 1 To 80) As tPar

 

Sub Main()

Dim x, prijogo, ultjogo As Integer

    ultjogo = ActiveCell.SpecialCells(xlLastCell).Row

    For x = 1 To 16

        prijogo = Worksheets(1).Cells(x, 9).Value

        If IsEmpty(prijogo) Then

            prijogo = 1

        Else

            prijogo = CInt(prijogo)

        End If

        Call CriaJogo(x, prijogo, ultjogo)

    Next x

End Sub

 

Sub CriaJogo(ByVal ppj As Integer, ByVal pj As Integer, uj As Integer)

Dim x, y, z As Integer

Dim p1, p2 As Integer

 

' iniciar array

For x = 1 To 80

    For y = 1 To 80

        With Par(x, y)

            .d1 = x

            .d2 = y

            .cnt = 0

        End With

    Next y

Next x

   

' computar pares de cada jogo

For x = pj To uj

    Call ContaPar(x, 1, 2)

    Call ContaPar(x, 2, 3)

    Call ContaPar(x, 3, 4)

    Call ContaPar(x, 4, 5)

Next x

 

' ordenar array mantendo 1ª dez do par

Dim aux As tPar

For x = 1 To 80

    ' ordenar Par(x)

    For y = 1 To 79

        For z = (y + 1) To 80

            If Par(x, y).cnt < Par(x, z).cnt Then

                aux = Par(x, y)

                Par(x, y) = Par(x, z)

                Par(x, z) = aux

            End If

        Next z

    Next y

Next x

 

' achar par mais ocorrido na estatística

z = 1

For x = 2 To 80

    If Par(x, 1).cnt > Par(z, 1).cnt Then z = x

Next x

 

' criar jogo iniciado pelo par da 1ª dez

Dim j(1 To 5) As Integer

j(1) = Par(z, 1).d1

j(2) = Par(z, 1).d2

For x = 3 To 5

    z = 1

    Do

        j(x) = Par(j(x - 1), z).d2

        If JaTem(j, x) Then

          ' tentar pares seguintes da mesma dezena

            z = z + 1

        Else

            Exit Do

        End If

    Loop

Next x

 

For x = 1 To 5

    Worksheets(1).Cells(ppj, x + 9).Value = j(x)

Next x

 

MsgBox “O.K.”

End Sub

       

Sub ContaPar(ByVal j As Integer, ByVal p1 As Integer, ByVal p2 As Integer)

' contar +1 para o par passado

    ' recebe as pos, muda para as dezenas corresp

    p1 = Worksheets(1).Cells(j, p1).Value

    p2 = Worksheets(1).Cells(j, p2).Value

    Par(p1, p2).cnt = Par(p1, p2).cnt + 1

End Sub

 

Function JaTem(ByRef a() As Integer, ByVal u As Integer) As Boolean

' comparar elems anters do array com o ultimo

    Dim x As Integer

    JaTem = False

    For x = 1 To (u - 1)

        If a(x) = a(u) Then JaTem = True

    Next x

End Function

 

Variante: PARES QUAISQUER – TERNOS QUAISQUER

Desconsiderando a ordem de sorteio, contar todos os pares que possam ser formados com as dezenas de cada sorteio. Outra variante seria usar ternos ao invés de pares, mas não vale a pena trabalhar com grupos ainda maiores como quadras ou quinas, pois a freqüência de sorteio vai na razão inversa do tamanho.

 

[Métodos De Apostar (1)]

OBS.: a linguagem usada nos exemplos é o VBA para Excel.

MAIS FREQUENTES

O método mais simples, claro, é contar todas as dezenas que já saíram e escolher as mais (ou menos) freqüentes.

' OBS.1: jogo estudado - Quina

' OBS.2: já foi feita a colagem na planilha,

usando Dados/De Texto e ignorando outras colunas que não as Dezenas

 

Type tipada

Dez As Integer

Qtd As Integer

End Type

 

Dim Censo(1 To 80) As tipada

 

Sub Main()

Dim x, n, ult As Integer

Dim rng As String

 

For ult = 1 To 16380

If Trim(Worksheets(1).Cells(ult, 1).Text) = Space(0) Then Exit For

Next ult

rng = "A1:E" & u

 

For Each c In Worksheets(1).Range(rng).Cells

n = CInt(c.Value)

Censo(n).Dez = n

Censo(n).Qtd = Censo(n).Qtd + 1

Next c

 

For x = 1 To 80

Worksheets(1).Cells(x, 8) = Censo(x).Dez

Worksheets(1).Cells(x, 9) = Censo(x).Qtd

Next x

 

MsgBox "O.K."

End Sub