ppaaoolloo
Super Member >PLATINUM<
ciao
questo listato mi era stato fatto cortesemente da Ilegend
pochi mesi fa, chiedo se si può aggiungere una colonna
che sommi RcP1 + RcP2
ringrazio anticipatamente della disponibilità
salutoni
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 listato mi era stato fatto cortesemente da Ilegend
pochi mesi fa, chiedo se si può aggiungere una colonna
che sommi RcP1 + RcP2
ringrazio anticipatamente della disponibilità
salutoni
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
