correzione joe91mike58?

[keeper]

mi date una mano a correggere questo script che mi sono creato da solo?

Sub Main()
ImpostaArchivio10ELotto(2)
'-------------------------------------------------------------------------------------------------------------------------------
Dim num(3)
Dim nm(40)
Dim lun(90)
Dim anm(90)
fin = EstrazioniArchivioDL
storia = InputBox("Estrazioni Iniziale..",,fin)
lis = InputBox("verifica garanzia 3 = ambo 3 = terzina 4=Quaterna 5=Cinquina 6=Sestina ",,3)
s1 = InputBox("esamina solo presenze = 3 ",,3)
s3 = InputBox("vuoi aggiungere fissi una 1 decina ? ",,11)
s4 = InputBox("Verifica in n.colpi..",,3)

ColoreTesto 2
Scrivi " Ricerca Numeri che si sono ripetuti in 3 concorsi consecutivi nel range dal....al...." & Storia & "/" & DataEstrazioneDL(storia) & " - " & fin & "/" & DataEstrazioneDL(fin)
Scrivi "_________________________________________________________________________________________________________________________________"
Scrivi
ColoreTesto 0
Ini = storia - 1
For Ini = Ini + 1 To fin
idestr = Ini
numeria = ""
numerib = ""
numeric = ""
ok = 0
lunghetta = ""
z = z + 1
'''azzera schiere
For j = 1 To 90
anm(j) = 0
lun(j) = 0
Next

'''carica schiera con 20 numeri estratti
For h = 1 To 20
numeria = numeria & Format2(EstrattoDL(idestr - 1,h)) & " "
numerib = numerib & Format2(EstrattoDL(idestr,h)) & " "
numeric = numeric & Format2(EstrattoDL(idestr,h)) & " "
Next
ColoreTesto 0
Scrivi "____________________________________________________________________________________________________"
Scrivi GetInfoEstrazioneDL(idestr - 1) & "...Estratti..." & numeria
Scrivi GetInfoEstrazioneDL(idestr) & "...Estratti..." & numeriB
Scrivi GetInfoEstrazioneDL(idestr) & "...Estratti..." & numeric
ColoreTesto 2


''''----------------------------------------------------------------------------------------------------
num(1) = 0
num(2) = 0
num(3) = 0
''''''vede se presenze = 3 in 3 concorsi
For h = 1 To 20
num(1) = EstrattoDL(idestr,h)
pres = SerieFreqDL(idestr - 1,idestr,num,1)
If pres = 3 Then
ok = ok + 1
lun(ok) = Format2(num(1))
End If
Next
'''aggiungere una decina come fissi
If s3 > 0 Then
de = s3
For x = 1 To 10
ok = ok + 1
lun(ok) = de
de = de + 1
Next
End If


''''----------------------------------------------------------------------------------------------------
EliminaRipetuti lun
ctr = 0
For j = 1 To 90
If lun(j) > 0 Then
lunghetta = lunghetta & Format2(lun(j)) & " "
ctr = ctr + 1
End If

Next
ColoreTesto 2
Scrivi "...numeri.in gioco..." & ctr & "......dal........" & idestr + 1 & "..." & lunghetta
ColoreTesto 0

If idestr <= fin - 1 Then
If ok >= 1 Then
If VerificaEsitoDL(lun,idestr + 1,lis,Int(s4),RetEsito,RetColpi,RetEstratti,RetIdEstr) Then
ColoreTesto 2
Call Scrivi(GetInfoEstrazioneDL(RetIdEstr) & " " & RetEsito & " colpi : " & RetColpi & " " & RetEstratti)
combin1 = combin1 + 1
ColoreTesto 0

If RetEsito = "Sestina" Then
seitotali = seitotali + 1
End If
If RetEsito = "Cinquina" Then
Cinquitotali = Cinquitotali + 1
End If
If RetEsito = "Quaterna" Then
Quatetotali = Quatetotali + 1
End If
If RetEsito = "Terno" Then
ternitotali = ternitotali + 1
End If
If RetEsito = "Ambo" Then
ambitotali = ambitotali + 1
End If


End If
End If
End If
Next
ColoreTesto 0
Scrivi
Scrivi " R_I_E_P_I_L_O_G_O_ "
Scrivi "Ambata totali realizzati..." & Estrattototali
Scrivi "Ambi totali realizzati..." & ambitotali
Scrivi "Terni totali realizzati..." & ternitotali
Scrivi "Quaterne totali realizzati..." & Quatetotali
Scrivi "Cinquine totali realizzati..." & Cinquitotali
Scrivi "6 Punti totali realizzati..." & Seitotali
Scrivi "concorsi esaminati totale.." & z
Scrivi "Vincenti Combinazione ....." & combin1


End Sub
il problema è che non riesco a rilevare il numero ripetuto con presenza 3 nelle 3 estrazioni consecutive
nb. alla richiesta della decina inserite lo zero

 

[keeper]

è questa la soluzione?

'''carica schiera con 20 numeri estratti
For h = 1 To 20
numeria = numeria & Format2(EstrattoDL(idestr - 2,h)) & " "
numerib = numerib & Format2(EstrattoDL(idestr - 1,h)) & " "
numeric = numeric & Format2(EstrattoDL(idestr,h)) & " "
Next
ColoreTesto 0
Scrivi "____________________________________________________________________________________________________"
Scrivi GetInfoEstrazioneDL(idestr - 2) & "...Estratti..." & numeria
Scrivi GetInfoEstrazioneDL(idestr - 1) & "...Estratti..." & numeriB
Scrivi GetInfoEstrazioneDL(idestr) & "...Estratti..." & numeric
ColoreTesto 2


''''----------------------------------------------------------------------------------------------------
num(1) = 0
num(2) = 0
num(3) = 0
''''''vede se presenze = 3 in 3 concorsi
For h = 1 To 20
num(1) = EstrattoDL(idestr,h)
pres = SerieFreqDL(idestr - 2,idestr,num,1)
If pres = 3 Then
ok = ok + 1
lun(ok) = Format2(num(1))
End If
Next

 

[Joe91]

Ciao Keeper ripeto quanto ho già scritto altrove.

E' un gioco, come molti altri, di cui preferisco non interessarmi e di cui non so nulla.

Non so come siano gli estratti, le estrazioni, le giocate, le strategie, le vincite ...

neppure "cosa facciano" le istruzioni e lo script che hai allegato.

Pertanto non avendo la capacità di capire la tua domanda, purtroppo non ti posso aiutare.

Buona Serata.

 

[keeper]

grazie lo stesso joe91 ma credo che la soluzione sia giusta. ora devo capire come fare in automatico ad inserire la 10ina

 

[keeper]

allora ora posto lo script secondo la mia modifica che sembra funzionare anche se so che di sicuro non è corretta

Sub Main()    ImpostaArchivio10ELotto(2)
    '-------------------------------------------------------------------------------------------------------------------------------
    Dim num(3)
    Dim nm(40)
    Dim lun(90)
    Dim anm(90)
    fin = EstrazioniArchivioDL
    storia = InputBox("Estrazioni Iniziale..",,fin)
    lis = InputBox("verifica garanzia   1 = estratto 2 = ambo 3 = terzina 4=Quaterna 5=Cinquina  6=Sestina ",,3)
    s1 = InputBox("esamina solo presenze = 3 ",,3)
    s3 = InputBox("vuoi aggiungere fissi una 1 decina ? ",,0)
    s4 = InputBox("Verifica in n.colpi..",,12)
    
    ColoreTesto 2
    Scrivi " Ricerca Numeri che si sono ripetuti in 3 concorsi consecutivi nel range dal....al...." & Storia & "/" & DataEstrazioneDL(storia) & "    -    " & fin & "/" & DataEstrazioneDL(fin)
    Scrivi "_________________________________________________________________________________________________________________________________"
    Scrivi
    ColoreTesto 0
    Ini = storia - 1
    For Ini = Ini + 1 To fin
        idestr = Ini
        numeria = ""
        numerib = ""
        numeric = ""
        ok = 0
        lunghetta = ""
        z = z + 1
        '''azzera schiere
        For j = 1 To 90
        anm(j) = 0
        lun(j) = 0
        Next
        
        '''carica schiera con 20 numeri estratti
        For h = 1 To 20
            numeria = numeria & Format2(EstrattoDL(idestr - 2,h)) & " "
            numerib = numerib & Format2(EstrattoDL(idestr - 1,h)) & " "
            numeric = numeric & Format2(EstrattoDL(idestr,h)) & " "
        Next
        ColoreTesto 0
        Scrivi "____________________________________________________________________________________________________"
        Scrivi GetInfoEstrazioneDL(idestr - 2) & "...Estratti..." & numeria
        Scrivi GetInfoEstrazioneDL(idestr - 1) & "...Estratti..." & numerib
        Scrivi GetInfoEstrazioneDL(idestr) & "...Estratti..." & numeric
        ColoreTesto 2


        ''''----------------------------------------------------------------------------------------------------
        num(1) = 0
        num(2) = 0
        num(3) = 0
        ''''''vede se presenze = 3 in 3 concorsi
        For h = 1 To 20
            num(1) = EstrattoDL(idestr,h)
            pres = SerieFreqDL(idestr - 2,idestr,num,1)
            If pres = 3 Then
                ok = ok + 1
                lun(ok) = Format2(num(1))
            End If
        Next
        '''aggiungere una decina come fissi
            If s3 > 0 Then
            de = s3
            For x = 1 To 10
            ok = ok + 1
            lun(ok) = de
            de = de + 1
            Next
            End If
                
                
        ''''----------------------------------------------------------------------------------------------------
                    EliminaRipetuti lun
                    ctr = 0
                    For j = 1 To 90
                        If lun(j) > 0 Then
                        lunghetta = lunghetta & Format2(lun(j)) & " "
                        ctr = ctr + 1
                        End If
                        
                    Next
                ColoreTesto 2
                Scrivi "...numeri.in gioco..." & ctr & "......dal........" & idestr + 1 & "..." & lunghetta
                ColoreTesto 0
                
        If idestr <= fin - 1 Then
            If ok >= 1 Then
    If VerificaEsitoDL(lun,idestr + 1,lis,Int(s4),RetEsito,RetColpi,RetEstratti,RetIdEstr) Then
                        ColoreTesto 2
                        Call Scrivi(GetInfoEstrazioneDL(RetIdEstr) & " " & RetEsito & " colpi : " & RetColpi & "             " & RetEstratti)
                        combin1 = combin1 + 1
                        ColoreTesto 0
                        
                        If RetEsito = "Sestina" Then
                            seitotali = seitotali + 1
                        End If
                        If RetEsito = "Cinquina" Then
                            Cinquitotali = Cinquitotali + 1
                        End If
                        If RetEsito = "Quaterna" Then
                            Quatetotali = Quatetotali + 1
                        End If
                        If RetEsito = "Terno" Then
                            ternitotali = ternitotali + 1
                        End If
                        If RetEsito = "Ambo" Then
                            ambitotali = ambitotali + 1
                        End If
                         If RetEsito = "Ambata" Then
                            Estrattotali = Estrattotoali + 1


                    End If
            End If
        End If
    End If


    Next
    ColoreTesto 0
    Scrivi
    Scrivi " R_I_E_P_I_L_O_G_O_ "
    Scrivi "Ambata   totali realizzati..." & Estrattototali
    Scrivi "Ambi     totali realizzati..." & ambitotali
    Scrivi "Terni    totali realizzati..." & ternitotali
    Scrivi "Quaterne totali realizzati..." & Quatetotali
    Scrivi "Cinquine totali realizzati..." & Cinquitotali
    Scrivi "sestine  totali realizzati..." & Seitotali
    Scrivi "concorsi esaminati totale.." & z
    Scrivi "Vincenti Combinazione ....." & combin1


End Sub

in poche parole lo script mi trova la ripetizione di un numero in 3 concorsi consecutivi
poi invece di inserire la decina manualmente io devo farglielo fare in automatico es. mi trova ripetuto il 45 lo script mette in gioco per la sorte che io inserisco es. il terno il numero 45 ripetuto più tutta la sua decina dal 41 al 50 verificando poi la sorte
con un folgio excel ho osservato tale condizione e sto cercando di ripetere lo stesso ragionamento con uno script. perchè questo?
perchè mi sono accorto che nell'arco di 12 colpi si formano delle terzine o quartine allego immagine.

 

[keeper]

di questo non ne avevo tenuto conto converrebbe twnere separate le combinazioni oppure per una migliore veduta grafica distribuirle in una tabella con due colonne il ripetuto e la decina. dalla statistica se si vorrebbe giocare un sistema accettabile formato da capogioco + due numeri si avrebbero cosi 9 terzine ma cmq insostenibili nel cosa di dodici colpi successivi. da dove lo prendi prendi sto gioco resta infernale non tu dico che fine deve fare l'inventore

 

[keeper]

ok gentile come sempre studiaci anche te un pò perchè penso che stavolta qualcosa di buono riusciremo ad ottenere

 

[keeper]

bisognerebbe inserire un ridotto qualcosa del genere preso da un tuo script

ColoreTesto 0
'''prepara campi per lancio sviluppo del sistema ridotto
completa = lunghetta
k = s4
If Int(ctr) > 6 And Int(ctr) < 23 Then
risultati = Getridotto(completa,g,ctr,idestr,lis,k)
'''accumula punteggi del sistema
ReDim aV2(0)
Call SplitByChar(risultati,".",aV2) ' scompongo risultati x sorte
If aV2(0) > 0 Then die = die + Int(aV2(0))
If aV2(1) > 0 Then nov = nov + Int(aV2(1))
If aV2(2) > 0 Then ott = ott + Int(aV2(2))
If aV2(3) > 0 Then sett = sett + Int(aV2(3))
If aV2(4) > 0 Then sei = sei + Int(aV2(4))
If aV2(5) > 0 Then cinq = cinq + Int(aV2(5))
If aV2(6) > 0 Then quat = quat + Int(aV2(6))
If aV2(7) > 0 Then tre = tre + Int(aV2(7))
Else
ColoreTesto 2
Scrivi " Sistema NON SVILUPPABILE per mancanza del ridotto..."
ColoreTesto 0
End If
Next
ColoreTesto 0
Scrivi
Scrivi " R_I_E_P_I_L_O_G_O_ "
Scrivi "3 Punti totali realizzati..." & tre
Scrivi "4 Punti totali realizzati..." & quat
Scrivi "5 Punti totali realizzati..." & cinq
Scrivi "6 Punti totali realizzati..." & sei
Scrivi "7 Punti totali realizzati..." & sett
Scrivi "8 Punti totali realizzati..." & ott
Scrivi "9 Punti totali realizzati..." & nov
Scrivi "10 Punti totali realizzati..." & die
Scrivi "concorsi esaminati totale.." & z
Scrivi "Vincenti Combinazione ....." & combin1
End Sub
''''-------------------------------------------------------------------------------------------------------------------------
Function Getridotto(completa,g,ctr,idestr,lis,k)
'leggo file(tutti i record dello sviluppo ridotto richiesto)
Dim namefile
Dim sFile
ReDim aRighe(0)
ReDim asvil(0)
ReDim numeri(90)
If Int(ctr) = 7 Then
namefile = "C:\Temp\SVILUPPOBASE\765.txt"
End If
If Int(ctr) = 8 Then
namefile = "C:\Temp\SVILUPPOBASE\865.txt"
End If
If Int(ctr) = 9 Then
namefile = "C:\Temp\SVILUPPOBASE\965.txt"
End If
If Int(ctr) = 10 Then
namefile = "C:\Temp\SVILUPPOBASE\n10g10f0.txt"
End If
If Int(ctr) = 11 Then
namefile = "C:\Temp\SVILUPPOBASE\n11g7f0.txt"
End If
If Int(ctr) = 12 Then
namefile = "C:\Temp\SVILUPPOBASE\n12g7f0.txt"
End If
If Int(ctr) = 13 Then
namefile = "C:\Temp\SVILUPPOBASE\n13g7f0.txt"
End If
If Int(ctr) = 14 Then
namefile = "C:\Temp\SVILUPPOBASE\n14g7f0.txt"
End If
If Int(ctr) = 15 Then
namefile = "C:\Temp\SVILUPPOBASE\n15g8f0.txt"
End If
If Int(ctr) = 16 Then
namefile = "C:\Temp\SVILUPPOBASE\n16g7f0.txt"
End If
If Int(ctr) = 17 Then
namefile = "C:\Temp\SVILUPPOBASE\n17g7f0.txt"
End If
If Int(ctr) = 18 Then
namefile = "C:\Temp\SVILUPPOBASE\n18g6f0.txt"
End If
If Int(ctr) = 19 Then
namefile = "C:\Temp\SVILUPPOBASE\n19g6f0.txt"
End If
If Int(ctr) = 20 Then
namefile = "C:\Temp\SVILUPPOBASE\n20g6f0.txt"
End If
If Int(ctr) = 21 Then
namefile = "C:\Temp\SVILUPPOBASE\n21g6f0.txt"
End If
If Int(ctr) = 22 Then
namefile = "C:\Temp\SVILUPPOBASE\n22g6f0.txt"
End If
sFile = namefile
LeggiRigheFileDiTesto sFile,asvil
'ricerca last record e qta tot.record.presenti nel file
xbas = UBound(asvil)
''''' carica schiera con numeri da metodo
jj = 1
For j = 1 To Int(ctr)
If Mid(completa,jj,2) <> " " Then
numeri(j) = Mid(completa,jj,2)
End If
jj = jj + 3
Next
If xbas >= 0 Then
For U = 0 To xbas
' 'scompongo la decina
Dim t
Dim n
ReDim Nums(90)
ReDim aV(0)
Call SplitByChar(asvil(U),",",aV) ' scompongo la decina
n = UBound(aV)
If ctr > 9 Then
For t = 0 To n
Nums(t + 1) = numeri(aV(t))
Next
End If

If ctr < 10 Then
For t = 0 To 9
If t <= n Then
Nums(t + 1) = numeri(aV(t))
Else
Nums(t + 1) = 0
End If
Next
End If

nus = Nums(1) & " " & Nums(2) & " " & Nums(3) & " " & Nums(4) & " " & Nums(5) & " " & Nums(6) & " " & Nums(7) & " " & Nums(8) & " " & Nums(9) & " " & Nums(10)
Scrivi nus
If idestr + 1 < EstrazioniArchivioDL Then
If VerificaEsitoDL(Nums,idestr + 1,lis,Int(k),RetEsito,RetColpi,RetEstratti,RetIdEstr) Then
ColoreTesto 2
Call Scrivi(GetInfoEstrazioneDL(RetIdEstr) & " " & RetEsito & " colpi : " & RetColpi & " " & RetEstratti)
combin2 = combin2 + 1
ColoreTesto 0
If RetEsito = "Dieci" Then
Diecitotali = Diecitotali + 1
End If
If RetEsito = "Nove" Then
Novetotali = Novetotali + 1
End If
If RetEsito = "Otto" Then
Ottototali = Ottototali + 1
End If
If RetEsito = "Sette" Then
Settetotali = Settetotali + 1
End If
If RetEsito = "Sestina" Then
seitotali = seitotali + 1
End If
If RetEsito = "Cinquina" Then
Cinquitotali = Cinquitotali + 1
End If
If RetEsito = "Quaterna" Then
Quatetotali = Quatetotali + 1
End If
If RetEsito = "Terno" Then
ternitotali = ternitotali + 1
End If
If RetEsito = "Ambo" Then
ambitotali = ambitotali + 1
End If
If RetEsito = "Estratto" Then
Estrattototali = Estrattototali + 1
End If
Else
Call Scrivi("Negativo")
End If
End If
Next
If Diecitotali = "" Then Diecitotali = 0
If Novetotali = "" Then Novetotali = 0
If Ottototali = "" Then Ottototali = 0
If Settetotali = "" Then Settetotali = 0
If seitotali = "" Then seitotali = 0
If Cinquitotali = "" Then Cinquitotali = 0
If Quatetotali = "" Then Quatetotali = 0
If ternitotali = "" Then ternitotali = 0
risultati = Diecitotali & "." & Novetotali & "." & Ottototali & "." & Settetotali & "." & seitotali & "." & Cinquitotali & "." & Quatetotali & "." & ternitotali
Getridotto = risultati
End If
End Function
''''-------------------------------------------------------------------------------------------------------------------------

 

[keeper]

oppure il ripetuto deve essere riconosciuto come capogioco per capire il ritardo max dell'abbinamento in terzina

 

[keeper]

tu cosa ne pensi? ho letto in tuo post che la storia si ripete al 95% per cui bisognete bbe vefere i vari abbinamento oppure lavirare sulle frequenze?