Métodos De Apostar (3)

[Edgard Rocha]

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

 

[CRodrigues]

Parabéns pela postagem!
Tópico utilíssimo!