Novità

per Ilegend suo script da modificare

ppaaoolloo

Super Member >PLATINUM<
Ciao Ilegend
questo script che mi avevi fatto tempo fa se ti è possibile modificarlo
invece che per estratto farlo per ambo e eterno

ti ringrazio anticipatamente

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
    giovedì 24 luglio 2025
    Bari
    71
    27
    87
    61
    39
    Cagliari
    69
    17
    79
    09
    04
    Firenze
    32
    13
    25
    58
    22
    Genova
    24
    41
    61
    66
    16
    Milano
    55
    59
    33
    80
    38
    Napoli
    18
    52
    32
    12
    72
    Palermo
    49
    77
    78
    90
    60
    Roma
    35
    04
    30
    02
    44
    Torino
    19
    79
    56
    77
    26
    Venezia
    82
    59
    68
    24
    21
    Nazionale
    81
    32
    19
    60
    38
    Estrazione Simbolotto
    Nazionale
    32
    07
    29
    37
    28

Ultimi Messaggi

Indietro
Alto