Novità

variazione oppure aggiunta per script Ilegend

ppaaoolloo

Super Member >PLATINUM<
Salve
metto qui sotto uno script che gentilmente Ilegend mi aveva fatto un po'
di tempo fa, con la possibilità di poter avere dei numeri consecutivi per ambi
oppure terzine oppure quaterne ecc.
se possibile vorrei una variazione nella ricerca dei numeri,
vorrei la possibilità mantenendo sempre lo stesso metodo ma di poter
aggiungere un'altra opzione nella ricerca
cioè quella di poter trovare solo i numeri dispari o solo i numeri dispari
sempre consecutivi
(ad esempio selezionando il terno dei numeri può uscire 11-13-15 oppure
25-27-29 ecc. oppure per ambi pari potrebbe uscire 10-12 oppure 46-48 ecc.)

confido ancora nella sua disponibilità e pazienza tenendo conto che si possa fare
e spero che ne abbia il tempo e la voglia di rimetterci mano

ringrazio anticipatamente
il tempo




Option Explicit

Sub Main
Call MsgBox("controllare che i dati in output siano esatti, non se ne garantisce l ' esattezza." & vbCrLf & _
"controllare se ci sono eventuali bugs, e segnalarli" & vbCrLf & _
"lo script è dato cosi com ' è, in modalita gratuita, nessuno puo venderlo o cederlo in cambio di una donazione" & vbCrLf & _
"il gioco è vietato ai minori di anni 18 e può provocare grave dipendenza patologica" & vbCrLf & _
"lo script è una richiesta dell utente ppaaoolloo di lottoCed" & vbCrLf & _
"Le modifiche allo script possono comprometterne il funzionamento",vbInformation,"informazioni generali script")
If MsgBox("Non si garantisce la correttezza dei dati Riportati " & vbCrLf & "Vuoi continuare ugualmente ?",_
32 + 4,"Script Statistico Estratti nelle 5 posizioni") = vbYes Then
Dim aSviluppo:aSviluppo = Array("Integrale","Ridotto Consecutivi")
Dim aClasse
Dim aSviRuote:aSviRuote = Array("Ruote Unite","Ruote Separate")
Dim Ini,Fin,bRet,aComb,nClasse,idComb,N,IdSvi,sRic,sRu,idRicRu,IdForm,ColT,idCls
bRet = False
If ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin) Then
ReDim aRuote(0) :Call ScegliRuote(aRuote)
If UBound(aRuote) Then
If UBound(aRuote) = 1 Then
idRicRu = 1
Else
idRicRu = ScegliOpzioneMenu(aSviRuote,0,"Scegli Sviluppo ruote") + 1
End If
If idRicRu Then
IdSvi = ScegliOpzioneMenu(aSviluppo,0,"Scegli Sviluppo Combinazioni") + 1
If IdSvi Then
If IdSvi = 1 Then
idCls = 1
aClasse = Array("Estratti","Coppie")
nClasse = ScegliOpzioneMenu(aClasse,0,"Scegli Classe Combinazioni") + idCls
ElseIf IdSvi = 2 Then
idCls = 2
aClasse = Array("Coppie","Terne","Quaterne","Cinquine","Sestine","Settine","Ottine","Novine","Decine")
nClasse = ScegliOpzioneMenu(aClasse,0,"Scegli Classe Combinazioni") + idCls
End If
If nClasse Then
bRet = True
Else
Call MsgBox("Non hai inserito alcuna classe",vbYes,"Wrong Message")
End If
Else
Call MsgBox("Non hai selezionato correttamente la" & vbCrLf & "modalita di sviluppo combinazione",vbYes,"Wrong Message")
End If
Else
Call MsgBox("Non hai inserito il collegamento Ruote ",vbYes,"Wrong Message")
End If
ElseIf UBound(aRuote) <= 0 Then
Call MsgBox("Non hai inserito alcuna ruota",vbYes,"Wrong Message")
End If
Else
Call MsgBox("Il range Estrazioni inserito non è valido",vbYes,"Wrong Message")
End If
Else
Exit Sub
End If
If bRet = False Then Exit Sub
If IdSvi = 1 And idRicRu = 2 Then nClasse = 1 :Call MsgBox("Su ruote separate è consentita solo la classe di sviluppo Estratto",vbInformation,"Info sviluppo combinazioni")
Call ResetTimer()
Dim aTit:aTit = Array(0,"IdComb","Ruote","Formazione","FrP1","FrP2","FrP3","FrP4","FrP5","SumFre","FreqMin","FreqMax","RcP1","RcP2","RcP3","RcP4","RcP5","SumRit","RitMin","RitMax","RsP1","RsP2","RsP3","RsP4","RsP5","RstMin","RstMax")
Call InitTabella(aTit)
ReDim aNum(90)
For N = 1 To 90
aNum(N) = N
Next
ColT = InitSviluppoIntegrale(aNum,nClasse)
IdForm = 0
Select Case IdSvi
Case 1
If idRicRu = 1 Then
Do While GetCombSviluppo(aNum)
IdForm = IdForm + 1
If ScriptInterrotto Then Exit Do
Call AvanzamentoElab(1,ColT,IdForm)
Call GetStat(IdForm,Ini,Fin,aRuote,aNum)
Loop
Else
Do While GetCombSviluppo(aNum)
If ScriptInterrotto Then Exit Do
Call AvanzamentoElab(1,ColT,IdForm)
IdForm = IdForm + 1
Call GetStatSep(IdForm,Ini,Fin,aRuote,aNum)
Loop
End If
Case 2
If idRicRu = 1 Then
Do While GetCombSviluppoRid(aNum,1)
If ScriptInterrotto Then Exit Do
IdForm = IdForm + 1
Call AvanzamentoElab(1,90 -(nClasse - idCls),IdForm)
Call GetStat(IdForm,Ini,Fin,aRuote,aNum)
Loop
Else
Do While GetCombSviluppoRid(aNum,1)
If ScriptInterrotto Then Exit Do
IdForm = IdForm + 1
Call AvanzamentoElab(1,90 -(nClasse - idCls),IdForm)
Call GetStatSep(IdForm,Ini,Fin,aRuote,aNum)
Loop
End If
End Select
' scrivo i parametri di ricerca
Scrivi FormatSpace(" Analisi Ritardi e Frequenze di una formazione nelle cinque posizioni",194),1,,RGB(240,240,240),RGB(100,100,100)
Scrivi FormatSpace(" ",194),,,RGB(238,238,239),vbWhite
Scrivi FormatSpace(" Data inizio Analisi: " & DataEstrazione(Ini) & " ( Conc: " & FormatSpace(Ini,5,1) & " )",194),1,,RGB(245,245,247),RGB(100,100,100)
Scrivi FormatSpace(" Data fine Analisi: " & DataEstrazione(Fin) & " ( Conc: " & FormatSpace(Fin,5,1) & " )",194),1,,RGB(246,246,248),RGB(100,100,100)
Scrivi FormatSpace(" Analisi Ruote: " & aSviRuote(idRicRu - 1),194),1,,RGB(246,246,248),RGB(100,100,100)
Scrivi FormatSpace(" Sistema Sviluppo: " & aSviluppo(IdSvi - 1),194),1,,RGB(246,246,248),RGB(100,100,100)
Scrivi FormatSpace(" Formazione: " & aClasse(nClasse - idCls),194),1,,RGB(246,246,248),RGB(100,100,100)
Scrivi FormatSpace(" ",194),,,RGB(248,248,250)
Scrivi
Scrivi FormatSpace(" Legenda Colori utilizzati ",194),1,,RGB(0,128,192),RGB(240,250,255)
Scrivi
Scrivi " FreqMin,RitMin,RstoMin ",1,,RGB(255,128,128),RGB(83,0,0)
Scrivi
Scrivi " FreqMax,RitMax,RstoMax ",1,,RGB(118,235,156)
Scrivi
Call SetTableWidth("100%")
Call SetTableHeight("286 pxz")
Scrivi "Elaborato in : " & TempoTrascorso()
Call CreaTabellaOrdinabile()
End Sub
Sub GetStat(idSvi,Ini,Fin,aRu,aNum)
Dim p,C,Rit,RitMax,Freq,SumRit,SumFreq,aTab
Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
Dim aRit(5),aRitMax(5),aFreq(5),aPos(1)
SumRit = 0
SumFreq = 0
For p = 1 To 5
aPos(1) = p
Call StatisticaFormazioneTurbo(aNum,aRu,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
aRit(p) = Rit
aRitMax(p) = RitMax
aFreq(p) = Freq
SumRit = SumRit + Rit
SumFreq = SumFreq + Freq
Next
RcMin = MinimoV(aRit,1,5)
RcMax = MassimoV(aRit)
FreqMin = MinimoV(aFreq,1,5)
RstoMax = MassimoV(aRitMax)
RstoMin = MinimoV(aRitMax,1,5)
FreqMax = MassimoV(aFreq)
aTab = Array(0,idSvi,StringaRuote(aRu),StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
Call AddRigaTabella(aTab,RGB(234,234,255))
Call ColoraCella(aTab)
End Sub
Sub GetStatSep(idSvi,Ini,Fin,aRu,aNum)
Dim p,C,R,Rit,RitMax,Freq,SumRit,SumFreq,aTab
Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
Dim aRit(5),aRitMax(5),aFreq(5),aPos(1),aRsing(1)
For R = 1 To UBound(aRu)
aRsing(1) = aRu(R)
SumRit = 0
SumFreq = 0
For p = 1 To 5
aPos(1) = p
Call StatisticaFormazioneTurbo(aNum,aRsing,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
aRit(p) = Rit
aRitMax(p) = RitMax
aFreq(p) = Freq
SumRit = SumRit + Rit
SumFreq = SumFreq + Freq
Next
RcMin = MinimoV(aRit,1,5)
RcMax = MassimoV(aRit)
FreqMin = MinimoV(aFreq,1,5)
RstoMax = MassimoV(aRitMax)
RstoMin = MinimoV(aRitMax,1,5)
FreqMax = MassimoV(aFreq)
aTab = Array(0,idSvi,NomeRuota(aRsing(1)),StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
Call AddRigaTabella(aTab,RGB(234,234,255))
Call ColoraCella(aTab)
Next
End Sub
Sub ColoraCella(aTab)
Dim c
Call SetColoreCella(1,RGB(240,240,240),RGB(128,0,0))
Call SetColoreCella(2,RGB(215,255,255),RGB(20,68,107))
Call SetColoreCella(3,RGB(215,255,255),RGB(20,68,107))
For c = 4 To 8
If aTab(c) = aTab(10) Then
Call SetColoreCella(Int(c),RGB(255,128,128),RGB(83,0,0))
ElseIf aTab(c) = aTab(11) Then
Call SetColoreCella(Int(c),RGB(118,235,156),RGB(11,79,72))
End If
Next
Call SetColoreCella(9,vbWhite,RGB(0,100,0))
Call SetColoreCella(10,vbWhite,RGB(255,0,0))
Call SetColoreCella(11,vbWhite,RGB(0,73,147))
For c = 12 To 16
If aTab(c) = aTab(18) Then
Call SetColoreCella(Int(c),RGB(255,128,128),RGB(83,0,0))
ElseIf aTab(c) = aTab(19) Then
Call SetColoreCella(Int(c),RGB(118,235,156),RGB(11,79,72))
End If
Next
Call SetColoreCella(17,vbWhite,RGB(0,100,0))
Call SetColoreCella(18,RGB(255,217,236))
Call SetColoreCella(19,vbWhite,RGB(0,73,147))
For c = 20 To 24
If aTab(c) = aTab(25) Then
Call SetColoreCella(Int(c),RGB(255,128,128),RGB(83,0,0))
ElseIf aTab(c) = aTab(26) Then
Call SetColoreCella(Int(c),RGB(118,235,156),RGB(11,79,72))
End If
Next
Call SetColoreCella(25,vbWhite,RGB(255,0,0))
Call SetColoreCella(26,vbWhite,RGB(0,73,147))
End Sub
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 26 luglio 2025
    Bari
    81
    09
    05
    54
    10
    Cagliari
    56
    07
    45
    69
    64
    Firenze
    39
    16
    56
    29
    09
    Genova
    67
    12
    55
    74
    04
    Milano
    40
    30
    44
    63
    27
    Napoli
    63
    07
    74
    86
    81
    Palermo
    80
    34
    16
    27
    53
    Roma
    08
    78
    43
    03
    52
    Torino
    38
    84
    47
    57
    20
    Venezia
    88
    70
    85
    65
    24
    Nazionale
    36
    09
    43
    55
    10
    Estrazione Simbolotto
    Nazionale
    25
    23
    13
    40
    35
Indietro
Alto