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
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
