Jump to content

Métodos De Apostar (4)


Recommended Posts

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

  • Like 1
Link to comment
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.
Note: Your post will require moderator approval before it will be visible.

Guest
Reply to this topic...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.

  • Recently Browsing   0 members

    • No registered users viewing this page.
×
×
  • Create New...