Novità

script per elaborare la legge del terzo sul 10 e lotto

numerico

numerico

Super Member >GOLD<
Premetto che ho fatto una ricerca certosina per trovare un listato con queste caratteristiche..... ma ahimè la ricerca è stata vana. C'è qualche volenteroso che è in grado di redigere un simile elaborato? Ringrazio anticipatamente chi vorrà usarmi questa cortesia.
Rimango in fiduciosa attesa.
Un cordiale saluto a tutti.
 
Al fine di agevolare il compito alla persona che ha le capacità di elaborare uno script, ho trovato in questo forum un listato che fa al caso mio, ma sfortunatamente è stato compilato per il gioco del lotto. E' possibile, quindi, modificarlo per adattarlo al 10 e lotto?
Questo è il listato:
-----------------------------------------------------------------------------------------------------------------
'Option Explicit
Sub Main
Dim ini,fin,ini1,es,ciclo,colpi,i,y,ii
Dim bEsito
Dim kGiocate,kCasi,kCasiPos,kAmbi,ktutto 'contatori capigioco, abbinamenti, giocate,casi tot, casi pos, ambirealizz
Dim aRuota(1),aPosta(2),aNum(1),aAmbo(2),tutto(1)
Dim RetEsito,RetColpi,RetEstratti,retId
ReDim Atutto(0) 'array per i CG (freq>2), gli abbin(freq=2)
aRuota(1) = CInt(InputBox(" Scegli la ruota di ricerca ",,"1"))
ini = CInt(InputBox(" Scegli l'estrazione di inizio ricerca ",,8700))
sfa = CInt(InputBox("Quanti superfrequenti ",,0))
clc = CInt(InputBox("Quanti cicli di gioco ",,54))
clp = CInt(InputBox("Quanti colpi di gioco ",,20))
fin = EstrazioneFin
ciclo = clc : ciclo = ciclo - 1 ' durata del ciclo di ricerca ripetuti. Non togliere il -1!
colpi = clp 'colpi di gioco
aPosta(2) = 1
For es = ini To fin Step ciclo + 1 ' analizzo l'archivo a blocchi di 9 estrazioni
cc = cc + 1
Messaggio es
Call AvanzamentoElab(ini,fin,es)
ini1 = es - ciclo ' calcolo l'inizio di ogni nuovo ciclo rispetto ad ogni es analizzata
ktutto = 0' ad ogni nuovo ciclo azzero i contatori
ReDim Atutto(0) ' e riazzero gli array prima di ogni ciclo
For ii = 1 To 90
tutto(1) = ii
If SerieFreqTurbo(ini1,es,tutto,aRuota,1) = sfa Then
ktutto = ktutto + 1
ReDim Preserve Atutto(ktutto)
Atutto(ktutto) = ii
End If
Next
kCasi = kCasi + 1
Call ColoreTesto(1)
Call Scrivi
Call Scrivi(String(155,"=") & " Caso n° " & cc)
Call Scrivi("Ricerca su " & SiglaRuota(aRuota(1)) & " ciclo di " & ciclo + 1 & " estrazioni (" & ini1 & "-" & es & ")" & " gioco fino..." & GetInfoEstrazione(es + colpi),1)
Call Scrivi("Tutti i Numeri con frequenza = " & sfa)
Scrivi StringaNumeri(Atutto) & " [ " & ktutto & " ] ",1
Call Scrivi(String(155,"="))

Call Scrivi
Call ColoreTesto(0)
kGiocate = 0 ' ad ogni nuova estrazione azzero il contatore delle giocate
bEsito = False
kCasiPos = kCasiPos + 1
'
Scrivi String(20,"-") & " Verifica esito nelle estrazioni successive " & String(20,"-")
kk = 0
estra = 0
ambo = 0
terno = 0
quat = 0
cinq = 0
For idestr = es + 1 To es + colpi
kk = kk + 1
Call VerificaEsitoTurbo(Atutto,aRuota,idestr,1,1,,RetEsito,RetColpi,RetEstratti,retId)
'Next
If RetEsito <> "" Then
ColoreTesto 0
If RetEsito = "Estratto" Then estra = estra + 1
If RetEsito = "Estratto" Then TE = TE + 1
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Ambo" Then ta = ta + 1
If RetEsito = "Ambo" Then ambo = ambo + 1
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Terno" Then terno = terno + 1
If RetEsito = "Terno" Then tte = tte + 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Quaterna" Then quat = quat + 1
If RetEsito = "Quaterna" Then tq = tq + 1
If RetEsito = "Cinquina" Then ColoreTesto 6
If RetEsito = "Cinquina" Then cinq = cinq + 1
If RetEsito = "Cinquina" Then tc = tc + 1
'kk = kk + 1
Call Scrivi(idestr & " - " & Format2(kk) & "° - " & RetEstratti & " - " & RetEsito & " - " & GetInfoEstrazione(retId),1)
ColoreTesto 0
End If
Next
Scrivi
Scrivi" Totali Estratto..." & estra & " ",True,False,0,5,2
Scrivi" Totali Ambi......." & ambo & " ",True,False,2,4,2
Scrivi" Totali Terni......" & terno & " ",True,False,4,2,2
Scrivi" Totali quaterne..." & quat & " ",True,False,7,0,2
Scrivi" Totali cinquine..." & cinq & " ",True,True,6,0,2
Call ColoreTesto(0)
If ScriptInterrotto Then Exit For
Next
Call Scrivi
Call Scrivi(String(60,"="))
Scrivi
Scrivi "Cicli.... " & cc,True,False,2,4,2
Scrivi " Colpi...." & clp,True,False,3,0,2
Scrivi " Tot. estrazioni ...." & cc*clp,True,True,4,2,2
Scrivi


Scrivi " Totali estratti..." & te,True,False,0,5,3
Scrivi " Totali Ambi......." & ta,True,False,2,4,3
Scrivi " Totali terni......" & tte,True,False,4,2,3
Scrivi " Totali Quaterne..." & tq,True,False,7,0,3
Scrivi " Totali Cinquine..." & tc,True,True,6,0,3
Scrivi
Call Scrivi(" Script Listed by Mike58 ",True,True,3,1,3)
End Sub
----------------------------------------------------------------------------------------------------------

Ringrazio di nuovo ed auguro una buona giornata a tutti.
 
ciao numerico, alias.... +/- dovrebbe essere cosi.


Codice: 
Sub Main
Dim ini,fin,ini1,es,ciclo,colpi,i,y,ii
Dim bEsito
Dim kGiocate,kCasi,kCasiPos,kAmbi,ktutto 'contatori capigioco, abbinamenti, giocate,casi tot, casi pos, ambirealizz
Dim aRuota(1),aPosta(2),aNum(1),aAmbo(2),tutto(1)
Dim RetEsito,RetColpi,RetEstratti,retId,sorte
ReDim Atutto(0) 'array per i CG (freq>2), gli abbin(freq=2)
arch = CInt (InputBox ("QUALE ARCHIVIO 10 e Lotto " & Chr(13) & "  " & Chr(13) &  "1 = 10 e lotto serale" & Chr(13) & "2 = 10 e lotto 5 Min ",,1))
ImpostaArchivio10ELotto(arch)
sorte = CInt(InputBox(" Scegli la sorte di verifica ",,"1"))
ini = CInt(InputBox(" Scegli l'estrazione di inizio ricerca ",,8665))
sfa = CInt(InputBox("Quanti superfrequenti ",,3))
clc = CInt(InputBox("Quanti cicli di gioco ",,10))
clp = CInt(InputBox("Quanti colpi di gioco ",,10))
fin = EstrazioniArchivioDL
ciclo = clc : ciclo = ciclo - 1 ' durata del ciclo di ricerca ripetuti. Non togliere il -1!
colpi = clp 'colpi di gioco
aPosta(2) = 1
Scrivi "Inizio estrazioni dal " & GetInfoEstrazioneDL(ini) & "  a  " & GetInfoEstrazioneDL(fin),True,False,2,4,3
If arch = 1 Then Scrivi "  10 e lotto Serale ",True,True,4,2,3
If arch = 2 Then Scrivi " 1o e lotto 5 Min ",True,True,4,2,3
For es = ini To fin Step ciclo + 1 ' analizzo l'archivo a blocchi di 9 estrazioni
cc = cc + 1
Messaggio es
Call AvanzamentoElab(ini,fin,es)
ini1 = es - ciclo ' calcolo l'inizio di ogni nuovo ciclo rispetto ad ogni es analizzata
ktutto = 0' ad ogni nuovo ciclo azzero i contatori
ReDim Atutto(0) ' e riazzero gli array prima di ogni ciclo
For ii = 1 To 90
tutto(1) = ii
If SerieFreqDL(ini1,es,tutto,sorte) = sfa Then
ktutto = ktutto + 1
ReDim Preserve Atutto(ktutto)
Atutto(ktutto) = ii
End If
Next
kCasi = kCasi + 1
Call ColoreTesto(1)
Call Scrivi
Call Scrivi(String(155,"=") & " Caso n° " & cc)
Call Scrivi("Ricerca su ciclo di " & ciclo + 1 & " estrazioni (" & ini1 & "-" & es & ")" & " gioco fino..." & GetInfoEstrazioneDL(es + colpi),1)
Call Scrivi("Tutti i Numeri con frequenza = " & sfa)
Scrivi StringaNumeri(Atutto) & " [ " & ktutto & " ] ",1
Call Scrivi(String(155,"="))

Call Scrivi
Call ColoreTesto(0)
kGiocate = 0 ' ad ogni nuova estrazione azzero il contatore delle giocate
bEsito = False
kCasiPos = kCasiPos + 1
'
Scrivi String(20,"-") & " Verifica esito nelle estrazioni successive " & String(20,"-")
kk = 0
estra = 0
ambo = 0
terno = 0
quat = 0
cinq = 0
sest = 0
Sett = 0
ot = 0
nov = 0
diec = 0
For idestr = es + 1 To es + colpi
kk = kk + 1
Call VerificaEsitoDL(Atutto,idestr,sorte,1,RetEsito,RetColpi,RetEstratti,retId)
'Next
If RetEsito <> "" Then
ColoreTesto 0
If RetEsito = "Estratto" Then estra = estra + 1
If RetEsito = "Estratto" Then TE = TE + 1
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Ambo" Then ta = ta + 1
If RetEsito = "Ambo" Then ambo = ambo + 1
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Terno" Then terno = terno + 1
If RetEsito = "Terno" Then tte = tte + 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Quaterna" Then quat = quat + 1
If RetEsito = "Quaterna" Then tq = tq + 1
If RetEsito = "Cinquina" Then ColoreTesto 6
If RetEsito = "Cinquina" Then cinq = cinq + 1
If RetEsito = "Cinquina" Then tc = tc + 1
If RetEsito = "Sestina" Then sest = sest + 1
If RetEsito = "Sette" Then Sett = Sett + 1
If RetEsito = "Otto" Then ot = ot + 1
If RetEsito = "Nove" Then nov = nov + 1
If RetEsito = "Dieci" Then diec = diec + 1

If RetEsito = "Sestina" Then tsest = tsest + 1
If RetEsito = "Sette" Then tSett = tSett + 1
If RetEsito = "Otto" Then ttot = ttot + 1
If RetEsito = "Nove" Then tnov = tnov + 1
If RetEsito = "Dieci" Then tdiec = tdiec + 1

'kk = kk + 1
Call Scrivi(idestr & " - " & Format2(kk) & "° - " & RetEstratti & " - " & RetEsito & " - " & vbTab &  GetInfoEstrazioneDL(retId),1)
ColoreTesto 0
End If
Next
Scrivi
Scrivi" Totali Estratto..." & estra & " ",True,False,0,5,2
Scrivi" Totali Ambi......." & ambo & " ",True,False,2,4,2
Scrivi" Totali Terni......" & terno & " ",True,False,4,2,2
Scrivi" Totali quaterne..." & quat & " ",True,False,7,0,2
Scrivi" Totali cinquine..." & cinq & " ",True,False,6,0,2
Scrivi" Totali sestine...." & sest & " ",True,False,0,5,2
Scrivi" Totali settina...." & Sett & " ",True,False,7,0,2
Scrivi" Totali ottine....." & ot & " ",True,False,6,0,2
Scrivi" Totali novine....." & nov & " ",True,False,0,5,2
Scrivi" Totali decina....." & diec & " ",True,True,6,0,2

Call ColoreTesto(0)
If ScriptInterrotto Then Exit For
Next
Call Scrivi
Call Scrivi(String(60,"="))
Scrivi
Scrivi "Cicli.... " & cc,True,False,2,4,2
Scrivi " Colpi...." & clp,True,False,3,0,2
Scrivi " Tot. estrazioni ...." & cc*clp,True,True,4,2,2
Scrivi


Scrivi " Totali estratti..." & te,True,False,0,5,3
Scrivi " Totali Ambi......." & ta,True,False,2,4,3
Scrivi " Totali terni......" & tte,True,False,4,2,3
Scrivi " Totali Quaterne..." & tq,True,False,7,0,3
Scrivi " Totali Cinquine..." & tc,True,False,6,0,3
Scrivi " Totali sestine...." & tsest,True,False,0,5,3
Scrivi " Totali settine...." & tsett,True,False,2,4,3
Scrivi " Totali ottine....." & ttot,True,False,4,2,3
Scrivi " Totali novine....." & tnov,True,False,7,0,3
Scrivi " Totali decine..." & tdiec,True,True,6,0,3
Scrivi
Call Scrivi(" Script Listed by Mike58 ",True,True,3,1,3)
End Sub
 
ciao mike58
cosa si intende con questa istruzione? Scegli la sorte di verifica ",,"1")) ovvero verivica l'ambata singola?. grazie
 
SI... keeper parte dalla sorte 1 ossia un punto ma conteggia ugualmente le sorti superiori se ci sono.

Ciao
 
Mike58 un particolare ringraziamento anche da parte mia. Ottimo lavoro. Ovviamente le frequenze le imposto a zero per verificare esattamente quanti numeri sono rimasti nell'urna dopo "x" cicli. Il ciclo naturale per il 10 e lotto (venendo sorteggiati 20 estratti) è di 4,5 estrazioni, pertanto partirei per una verifica da 2 cicli, ossia 9 estrazioni.
Grazie di nuovo ....e buona serata.
 
con il 10elotto 5 m
da errore qui
Call VerificaEsitoDL(Atutto,idestr,sorte,1,RetEsito,RetColpi,RetEstratti,retId)
 
Di nulla Numerico, sono d'accordo con l'impostazione che vuoi dare, le cose semplici sono le migliori.

Ciao
 
con il 10elotto 5 m
da errore qui
Call VerificaEsitoDL(Atutto,idestr,sorte,1,RetEsito,Ret Colpi,RetEstratti,retId)
Clicca per espandere...
9-Subscript out off range
qualche estrazione non valida?
Clicca per espandere...

Keeper , è il solito discorso l'inizio estrazione è settato per il 10 e lotto serale, per impostarlo per il 5 min devi trovare una estrazione di partenza valida.
 
Ciao Keeper,

una soluzione potrebbe essere la seguente :

Codice: 
Sub Main
Dim ini,fin,ini1,es,ciclo,colpi,i,y,ii
Dim bEsito
Dim kGiocate,kCasi,kCasiPos,kAmbi,ktutto 'contatori capigioco, abbinamenti, giocate,casi tot, casi pos, ambirealizz
Dim aRuota(1),aPosta(2),aNum(1),aAmbo(2),tutto(1)
Dim RetEsito,RetColpi,RetEstratti,retId,sorte
ReDim Atutto(0) 'array per i CG (freq>2), gli abbin(freq=2)
arch = CInt (InputBox ("QUALE ARCHIVIO 10 e Lotto " & Chr(13) & "  " & Chr(13) &  "1 = 10 e lotto serale" & Chr(13) & "2 = 10 e lotto 5 Min ",,1))
ImpostaArchivio10ELotto(arch)
sorte = CInt(InputBox(" Scegli la sorte di verifica ",,"1"))
If arch = 1 Then
ini = CInt(InputBox(" Scegli l'estrazione di inizio ricerca ",,8665))
Else
ini = CInt(InputBox(" Scegli l'estrazione di inizio ricerca ",,EstrazioniArchivioDL - 10))
End If
sfa = CInt(InputBox("Quanti superfrequenti ",,3))
clc = CInt(InputBox("Quanti cicli di gioco ",,10))
clp = CInt(InputBox("Quanti colpi di gioco ",,10))
fin = EstrazioniArchivioDL
ciclo = clc : ciclo = ciclo - 1 ' durata del ciclo di ricerca ripetuti. Non togliere il -1!
colpi = clp 'colpi di gioco
aPosta(2) = 1
Scrivi "Inizio estrazioni dal " & GetInfoEstrazioneDL(ini) & "  a  " & GetInfoEstrazioneDL(fin),True,False,2,4,3
If arch = 1 Then Scrivi "  10 e lotto Serale ",True,True,4,2,3
If arch = 2 Then Scrivi " 10 e lotto 5 Min ",True,True,4,2,3
For es = ini To fin Step ciclo + 1 ' analizzo l'archivo a blocchi di 9 estrazioni
cc = cc + 1
Messaggio es
Call AvanzamentoElab(ini,fin,es)
ini1 = es - ciclo ' calcolo l'inizio di ogni nuovo ciclo rispetto ad ogni es analizzata
ktutto = 0' ad ogni nuovo ciclo azzero i contatori
ReDim Atutto(0) ' e riazzero gli array prima di ogni ciclo
For ii = 1 To 90
tutto(1) = ii
If SerieFreqDL(ini1,es,tutto,sorte) = sfa Then
ktutto = ktutto + 1
ReDim Preserve Atutto(ktutto)
Atutto(ktutto) = ii
End If
Next
kCasi = kCasi + 1
Call ColoreTesto(1)
Call Scrivi
Call Scrivi(String(155,"=") & " Caso n° " & cc)
Call Scrivi("Ricerca su ciclo di " & ciclo + 1 & " estrazioni (" & ini1 & "-" & es & ")" & " gioco fino..." & GetInfoEstrazioneDL(es + colpi),1)
Call Scrivi("Tutti i Numeri con frequenza = " & sfa)
Scrivi StringaNumeri(Atutto) & " [ " & ktutto & " ] ",1
Call Scrivi(String(155,"="))

Call Scrivi
Call ColoreTesto(0)
kGiocate = 0 ' ad ogni nuova estrazione azzero il contatore delle giocate
bEsito = False
kCasiPos = kCasiPos + 1
'
Scrivi String(20,"-") & " Verifica esito nelle estrazioni successive " & String(20,"-")
kk = 0
estra = 0
ambo = 0
terno = 0
quat = 0
cinq = 0
sest = 0
Sett = 0
ot = 0
nov = 0
diec = 0
For idestr = es + 1 To es + colpi
kk = kk + 1
Call VerificaEsitoDL(Atutto,idestr,sorte,1,RetEsito,RetColpi,RetEstratti,retId)
'Next
If RetEsito <> "" Then
ColoreTesto 0
If RetEsito = "Estratto" Then estra = estra + 1
If RetEsito = "Estratto" Then TE = TE + 1
If RetEsito = "Ambo" Then ColoreTesto 2
If RetEsito = "Ambo" Then ta = ta + 1
If RetEsito = "Ambo" Then ambo = ambo + 1
If RetEsito = "Terno" Then ColoreTesto 1
If RetEsito = "Terno" Then terno = terno + 1
If RetEsito = "Terno" Then tte = tte + 1
If RetEsito = "Quaterna" Then ColoreTesto 7
If RetEsito = "Quaterna" Then quat = quat + 1
If RetEsito = "Quaterna" Then tq = tq + 1
If RetEsito = "Cinquina" Then ColoreTesto 6
If RetEsito = "Cinquina" Then cinq = cinq + 1
If RetEsito = "Cinquina" Then tc = tc + 1
If RetEsito = "Sestina" Then sest = sest + 1
If RetEsito = "Sette" Then Sett = Sett + 1
If RetEsito = "Otto" Then ot = ot + 1
If RetEsito = "Nove" Then nov = nov + 1
If RetEsito = "Dieci" Then diec = diec + 1

If RetEsito = "Sestina" Then tsest = tsest + 1
If RetEsito = "Sette" Then tSett = tSett + 1
If RetEsito = "Otto" Then ttot = ttot + 1
If RetEsito = "Nove" Then tnov = tnov + 1
If RetEsito = "Dieci" Then tdiec = tdiec + 1

'kk = kk + 1
Call Scrivi(idestr & " - " & Format2(kk) & "° - " & RetEstratti & " - " & RetEsito & " - " & vbTab &  GetInfoEstrazioneDL(retId),1)
ColoreTesto 0
End If
Next
Scrivi
Scrivi" Totali Estratto..." & estra & " ",True,False,0,5,2
Scrivi" Totali Ambi......." & ambo & " ",True,False,2,4,2
Scrivi" Totali Terni......" & terno & " ",True,False,4,2,2
Scrivi" Totali quaterne..." & quat & " ",True,False,7,0,2
Scrivi" Totali cinquine..." & cinq & " ",True,False,6,0,2
Scrivi" Totali sestine...." & sest & " ",True,False,0,5,2
Scrivi" Totali settina...." & Sett & " ",True,False,7,0,2
Scrivi" Totali ottine....." & ot & " ",True,False,6,0,2
Scrivi" Totali novine....." & nov & " ",True,False,0,5,2
Scrivi" Totali decina....." & diec & " ",True,True,6,0,2

Call ColoreTesto(0)
If ScriptInterrotto Then Exit For
Next
Call Scrivi
Call Scrivi(String(60,"="))
Scrivi
Scrivi "Cicli.... " & cc,True,False,2,4,2
Scrivi " Colpi...." & clp,True,False,3,0,2
Scrivi " Tot. estrazioni ...." & cc*clp,True,True,4,2,2
Scrivi


Scrivi " Totali estratti..." & te,True,False,0,5,3
Scrivi " Totali Ambi......." & ta,True,False,2,4,3
Scrivi " Totali terni......" & tte,True,False,4,2,3
Scrivi " Totali Quaterne..." & tq,True,False,7,0,3
Scrivi " Totali Cinquine..." & tc,True,False,6,0,3
Scrivi " Totali sestine...." & tsest,True,False,0,5,3
Scrivi " Totali settine...." & tsett,True,False,2,4,3
Scrivi " Totali ottine....." & ttot,True,False,4,2,3
Scrivi " Totali novine....." & tnov,True,False,7,0,3
Scrivi " Totali decine..." & tdiec,True,True,6,0,3
Scrivi
Call Scrivi(" Script Listed by Mike58 ",True,True,3,1,3)
End Sub

Vedi se puo' andar bene...


Ciao
 
Ultima modifica:
provato tutto ok all'inizio problemi di ower full ma era l'archivio gigante che avevo e non riusciva a gestirlo ora è trobcato e funzia bene anzi benissimo
 
Ciao a tutti...mi presento sono Andrea piacere di conoscervi...volevo sapere una cosa..quale è l'utilità di questo script riguardante il 10 e lotto??
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 18 giugno 2026
    Bari
    46
    70
    42
    50
    53
    Cagliari
    39
    01
    86
    43
    35
    Firenze
    20
    29
    14
    81
    62
    Genova
    84
    55
    72
    69
    41
    Milano
    37
    34
    72
    66
    13
    Napoli
    12
    68
    32
    56
    64
    Palermo
    15
    62
    43
    58
    09
    Roma
    65
    64
    11
    18
    62
    Torino
    56
    82
    58
    85
    87
    Venezia
    85
    86
    83
    62
    30
    Nazionale
    87
    66
    29
    82
    05
    Estrazione Simbolotto
    Napoli
    01
    25
    12
    18
    31
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto