Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Class Script
Sub Main
Dim ini , fin As Integer
Dim ritt , max ,fre , incr , pre , livello , snl As Integer
Dim n , k As Integer
Dim r , pos , rit , tot As Integer
ini = 1
fin = EstrazioniArchivio
tot = fin - ini + 1
'inserire qui il proprio codice...
Scrivi ("Cliccare su colonna per ordinare Decrescente - crescente ",1,,,,,,1)
'--------------------------------------------------------------------------------------------------------------------
Dim T() As String ={" ID "," Ruota "," NumeroRit "," RitCorr "," maxSto "," Freq "," incrmax ", "RitSncLiv" ,"Ind Conv "}
InitTabella(T ,ColoreBlu,,,ColoreBianco)
'--------------------------------------------------------------------------------------------------------------------
For r = 1 To 11
k +=1
pos = 1
n = NumeroPosRit(EstrazioniArchivio,r,pos)
rit = EstrattoRitardo(n,r,EstrazioniArchivio)
StatEstratto(n,r,ritt,max,fre,pre,incr,ini,fin)
snl = RitSincronoDiLivello( n,r,fin,livello )
'-----------------------------------------------------------
Dim V () As String
ReDim V (T.GetUpperbound(0))
V(0) = k
V(1) = NomeRuota(r)
V(2) = n
V(3) = rit
V(4) = max
V(5) = fre
V(6) = incr
V(7) = snl
V(8) = CalcolaIC (pre,ritt,tot )
Call AddRigaTabella(V)
'...........................................................................................
Next
Call CreaTabella ()
'-----------------------------------------------------------------------------------------------
Scrivi ("Tempo di Elaborazione.... ",0,0)
Scrivi (FormattaSecondi(SecondiTrascorsi))
Scrivi (" ***** Script by Mike58 ***** ",1)
Scrivi (" ***** Script by Mike58 ***** ",1,,-1,ColoreBlu,4,,True ) ' questa riga non funziona bene
'................................................................................................
End Sub
End Class
Class Script
Sub Main
Dim ini , fin As Integer
Dim ritt , max ,fre , incr , pre , livello , snl As Integer
Dim n , k As Integer
Dim r , pos , rit , tot As Integer
ini = 1
fin = EstrazioniArchivio
tot = fin - ini + 1
'inserire qui il proprio codice...
Scrivi ("Cliccare su colonna per ordinare Decrescente - crescente ",1,,,,,,1)
'--------------------------------------------------------------------------------------------------------------------
Dim T() As String ={" ID "," Ruota "," NumeroRit "," RitCorr "," maxSto "," Freq "," incrmax ", "RitSncLiv" ,"Ind Conv "}
Dim aColoriColonne (T.getupperbound(0)) As Integer
For k =0 To T.getupperbound(0)
If T(k).Trim = "RitCorr" Then
aColoriColonne (k) = ColoreRosso
ElseIf T(k).Trim = "Freq" Then
aColoriColonne (k) = ColoreVerde
Else
aColoriColonne (k) = ColoreGiallo
End If
Next
InitTabella(T ,ColoreBlu,,,ColoreBianco)
'--------------------------------------------------------------------------------------------------------------------
For r = 1 To 11
k +=1
pos = 1
n = NumeroPosRit(EstrazioniArchivio,r,pos)
rit = EstrattoRitardo(n,r,EstrazioniArchivio)
StatEstratto(n,r,ritt,max,fre,pre,incr,ini,fin)
snl = RitSincronoDiLivello( n,r,fin,livello )
'-----------------------------------------------------------
Dim V () As String
ReDim V (T.GetUpperbound(0))
V(0) = k
V(1) = NomeRuota(r)
V(2) = n
V(3) = rit
V(4) = max
V(5) = fre
V(6) = incr
V(7) = snl
V(8) = CalcolaIC (pre,ritt,tot )
Call AddRigaTabella(V,aColoriColonne )
'...........................................................................................
Next
Call CreaTabella ()
'-----------------------------------------------------------------------------------------------
Scrivi ("Tempo di Elaborazione.... ",0,0)
Scrivi (FormattaSecondi(SecondiTrascorsi))
Scrivi (" ***** Script by Mike58 ***** ",1)
Scrivi (" ***** Script by Mike58 ***** ",1,,-1,ColoreBlu,4,,True ) ' questa riga non funziona bene
For k = 100 To 500 Step 100
Scrivi (" ***** Script by Mike58 ***** ",True , ,ColoreVerde ,ColoreBianco ,k,,True )
Next
'................................................................................................
End Sub
End Class
mike ,non ho ancora aggiornato il programma alla versione 11,ho fatto eseguire il tuo script AGGIORNATO da Luigi ed ho la stessa sua immagine ( se puo servire),
).
Option Explicit
Class ClsLunghetta
Private aNumeri
Private aposizione(1) ' aggiunto valore di posizione
Private mInizio,mFine,aRuote,mSorte
Private mClasse
Private aElencoRit
Private aIdEstrElencoRit
Private aElencoIncrRitMax
Private aIdEstrIncrRitMax
Private aRitardiAllIncremento
Private mRitardo,mRitardoMax,mIncrRitMax,mFrequenza
Private mIncrRitardoMaxSto,mStrIncRitSto
Public Property Get iNumIncrementi
iNumIncrementi = UBound(aElencoIncrRitMax)
End Property
Public Property Get IncrRitMaxSto
IncrRitMaxSto = mIncrRitardoMaxSto
End Property
Public Property Get strIncRitMaxSto
strIncRitMaxSto = mStrIncRitSto
End Property
Public Property Get Ritardo
Ritardo = mRitardo
End Property
Public Property Get RitardoMax
RitardoMax = mRitardoMax
End Property
Public Property Get IncrRitMax
IncrRitMax = mIncrRitMax
End Property
Public Property Get Frequenza
Frequenza = mFrequenza
End Property
Public Property Get LunghettaString
LunghettaString = StringaNumeri(aNumeri)
End Property
Sub Init(sLunghetta,sChrSep,RangeInizio,RangeFine,vetRuote,SorteInGioco,aposizione)
mInizio = RangeInizio
mFine = RangeFine
aRuote = vetRuote
mSorte = SorteInGioco
Call AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Call ElencoRitardi(aNumeri,aRuote,mSorte,mInizio,mFine,aElencoRit,aIdEstrElencoRit)
Call AlimentaVettoreIncrRitMax
End Sub
Sub EseguiStatistica(aposizione)
Call StatisticaFormazioneTurbo(aNumeri,aRuote,mSorte,mRitardo,mRitardoMax,mIncrRitMax,mFrequenza,mInizio,mFine,,aposizione)
End Sub
Private Sub AlimentaVettoreLunghetta(sLunghetta,sChrSep)
Dim k
If IsArray(sLunghetta) Then
ReDim aNumeri(UBound(sLunghetta))
For k = 1 To UBound(sLunghetta)
aNumeri(k) = sLunghetta(k)
Next
Else
Call SplitByChar((sChrSep & sLunghetta),sChrSep,aNumeri)
End If
mClasse = UBound(aNumeri)
End Sub
Private Sub AlimentaVettoreIncrRitMax
Dim nRitMax,nIncr,nId,k
Dim nUpper
nId = 0
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
aElencoIncrRitMax(0) = aElencoRit(1)
For k = 1 To UBound(aElencoRit)
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
nIncr = aElencoRit(k) - nRitMax
nId = nId + 1
ReDim Preserve aElencoIncrRitMax(nId)
aElencoIncrRitMax(nId) = nIncr
ReDim Preserve aIdEstrIncrRitMax(nId)
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
ReDim Preserve aRitardiAllIncremento(nId)
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
nUpper = UBound(aElencoIncrRitMax)
mIncrRitardoMaxSto = MassimoV(aElencoIncrRitMax,1,nUpper - 1)
End Sub
Sub DisegnaGraficoIncrRitMax
Dim x,y,k
Dim nValoreMaxX,nValoreMaxY,nValoreMinX
Dim nStepX,nStepY
Dim nUpperVetIncrRit
nValoreMinX = MinimoV(aIdEstrIncrRitMax,1)
nValoreMaxX = aIdEstrIncrRitMax(UBound(aIdEstrIncrRitMax))
nValoreMaxY = MassimoV(aElencoRit,1)
nStepX =(nValoreMaxX -(mInizio - 1)) \10
nStepY = nValoreMaxY \10
Call PreparaGrafico("Formazione " & StringaNumeri(aNumeri),nValoreMinX,nValoreMaxX,0,nValoreMaxY,nStepX,nStepY)
nUpperVetIncrRit = UBound(aElencoIncrRitMax)
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit'+1
x = aIdEstrIncrRitMax(k)'+1
y = aElencoIncrRitMax(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncrRitMax")
ReDim aV(nUpperVetIncrRit - 1,2)
For k = 1 To nUpperVetIncrRit
x = aIdEstrIncrRitMax(k)
y = aRitardiAllIncremento(k)
aV(k - 1,1) = x
aV(k - 1,2) = y
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
Call InserisciGrafico
End Sub
End Class
Sub Main
Dim Inizio,Fine,Sorte,aRuote,clsL,aN,sChrSep,k,sFrz
Dim aposizione(5)
Dim quanteposizioniunite
quanteposizioniunite = CInt(InputBox("quante posizioni unite",,4))
Select Case(quanteposizioniunite)
Case 1
'Dim aposizione(1)
aposizione(1) = CInt(InputBox("posizione da analizzare",,1))
Case 2
'aposizione(2)
aposizione(1) = CInt(InputBox("prima posizione da analizzare",,1))
aposizione(2) = CInt(InputBox("seconda posizione da analizzare",,2))
Case 3
'aposizione(3)
aposizione(1) = CInt(InputBox("prima posizione da analizzare",,1))
aposizione(2) = CInt(InputBox("seconda posizione da analizzare",,2))
aposizione(3) = CInt(InputBox("terza posizione da analizzare",,3))
Case 4
'aposizione(4)
aposizione(1) = CInt(InputBox("prima posizione da analizzare",,1))
aposizione(2) = CInt(InputBox("seconda posizione da analizzare",,3))
aposizione(3) = CInt(InputBox("terza posizione da analizzare",,4))
aposizione(4) = CInt(InputBox("quarta posizione da analizzare",,5))
Case 5
'aposizione(5)
aposizione(1) = CInt(InputBox("prima posizione da analizzare",,1))
aposizione(2) = CInt(InputBox("seconda posizione da analizzare",,2))
aposizione(3) = CInt(InputBox("terza posizione da analizzare",,3))
aposizione(4) = CInt(InputBox("quarta posizione da analizzare",,4))
aposizione(5) = CInt(InputBox("quinta posizione da analizzare",,5))
End Select
'aposizione(1) = CInt(InputBox("posizione da analizzare ",,1))
sChrSep = " "
Inizio = EstrazioneIni
Fine = EstrazioneFin
Set clsL = New ClsLunghetta
ReDim aN(90)
If ScegliFormazione(aN) Then
For k = 1 To 90
If aN(k) Then
sFrz = sFrz & Format2(k) & ","
End If
Next
sFrz = RimuoviLastChr(sFrz,",")
aN = Array(0)
aN = array_push(aN,sFrz)
Sorte = SelEsito
Call ScegliRuote(aRuote,Nothing)
Call clsL.Init(aN,sChrSep,Inizio,Fine,aRuote,Sorte,aposizione)
Call clsL.EseguiStatistica(aposizione)
Call AvanzamentoElab(0,1,1)
Call Scrivi("Analisi incremento ritardo massimo per la sorte di " & NomeSorte(Sorte),True,,vbRed,vbWhite,4)
Call Scrivi
Call Scrivi("Sulla ruota di : " & StringaRuote(aRuote) & " ",True,,vbBlue,vbWhite,3)
Call Scrivi("Posizione n. : " & StringaNumeri(aposizione))
Call Scrivi("Da Estrazione : " & GetInfoEstrazione(Inizio),True,,vbBlue,vbWhite,3)
Call Scrivi("A Estrazione : " & GetInfoEstrazione(Fine),True,,vbBlue,vbWhite,3)
Call Scrivi
Call Scrivi("Numeri Formazione : " & clsL.LunghettaString,True,,,,2)
Call Scrivi("Ritardo attuale : " & clsL.Ritardo,True,,,,2)
Call Scrivi("Ritardo Massimo storico : " & clsL.RitardoMax,True,,,,2)
Call Scrivi("Frequenza : " & clsL.Frequenza,True,,,,2)
Call Scrivi("Incremento del ritardo massimo attuale : " & clsL.IncrRitMax,True,,,,2)
Call Scrivi("Incremento del ritardo massimo storico più alto : " & clsL.IncrRitMaxSto,True,,,,2)
Call Scrivi("Stringa degli incrementi : " & clsL.strIncRitMaxSto & ".<font color=red>" & clsL.IncrRitMax & "</font>",True,,,,2)
Call Scrivi
If clsL.RitardoMax > 0 Then
Call clsL.DisegnaGraficoIncrRitMax
End If
End If
End Sub
Function SelEsito
Dim ret
Dim aVoci
' gli array partono sempre da 0
aVoci = Array("","Estratto","Ambo","Terno","Quaterna","Cinquina")
ret = ScegliOpzioneMenu(aVoci,1," Analisi Posizionale per Sorte di : ")
SelEsito = ret
End Function
Function ScegliFormazione(aN)
Dim sFormazione
Dim k,i
sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"25.49")
ReDim aV(0)
Call SplitByChar(sFormazione,".",aV)
For k = 0 To UBound(aV)
If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then
aN(Int(aV(k))) = True
i = i + 1
End If
Next
If i > 0 Then ScegliFormazione = True
End Function
Function array_push(arr,vars)
Dim k,newelem,newarrsize,elem
If IsArray(arr) Then
If Len(vars) > 0 Then
If InStr(vars,",") = False Then
newarrsize = CInt(UBound(arr) + 1)
ReDim Preserve arr(newarrsize)
arr(newarrsize) = vars
Else
k =(UBound(arr) + 1)
newelem = Split(vars,",")
newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
ReDim Preserve arr(newarrsize)
For Each elem In newelem
arr(k) = Trim(elem)
k = k + 1
Next
End If
End If
array_push = arr
Else
array_push = False
End If
End FunctionVa benissimoBuongiorno a tutti ragazzi, sempre nell'ottica di cercare di migliorare e ottimizzare il già super favoloso programma dei grandissimi Edo e Luigi, mi sembra di aver riscontrato un'incongruenza con il grafico dell'incremento massimo per analisi posizionali (a proposito... figata pazzesca l'implementazione all'interno della sezione statistica! Top!
Di seguito la piccola incongruenza che mi pare di aver riscontrato..
Vedi l'allegato 2227176
gli incrementi sembrano non corrispondere...
sulla ruota di : TO
posizione n. : 2
da estrazione : [00001] [ 1 ] 07.01.1871
a estrazione : [10018] [151] 18.12.2021
numeri formazione : 25.77
ritardo attuale : 249
ritardo massimo storico : 249
frequenza : 196
incremento del ritardo massimo attuale : 26
incremento del ritardo massimo storico più alto : 26
stringa degli incrementi : 03.10.26.03.04.07.08.26
diff incmax posizionale : 0
e il grafico credo debba risultare così...
Vedi l'allegato 2227177
grazie per avermi avvertito. Non appena possibile controllerò, ora sto lavorando ad una funzione del programma per la quale mi stanno insistendo molte persone...ma appena finisco controllo Bene ho effettuato delle analisi Ne approfitto per dare anche una spiegazione.Buongiorno a tutti ragazzi, sempre nell'ottica di cercare di migliorare e ottimizzare il già super favoloso programma dei grandissimi Edo e Luigi, mi sembra di aver riscontrato un'incongruenza con il grafico dell'incremento massimo per analisi posizionali (a proposito... figata pazzesca l'implementazione all'interno della sezione statistica! Top!
Di seguito la piccola incongruenza che mi pare di aver riscontrato..
Vedi l'allegato 2227176
gli incrementi sembrano non corrispondere...
sulla ruota di : TO
posizione n. : 2
da estrazione : [00001] [ 1 ] 07.01.1871
a estrazione : [10018] [151] 18.12.2021
numeri formazione : 25.77
ritardo attuale : 249
ritardo massimo storico : 249
frequenza : 196
incremento del ritardo massimo attuale : 26
incremento del ritardo massimo storico più alto : 26
stringa degli incrementi : 03.10.26.03.04.07.08.26
diff incmax posizionale : 0
e il grafico credo debba risultare così...
Vedi l'allegato 2227177
Option Explicit
Class clsParStat
Dim idEstr
Dim RitMax
Dim IncrRitMax
End Class
Sub Main
Dim idEstr,Ruota,Sorte
Dim Inizio,Fine
Dim k,p,i,r,pMax
Dim Rit,RitMax,IncRitMax,Fre
Dim collStoria
Dim cParStat
Dim bEstrValida
Set collStoria = GetNewCollection
Inizio = EstrazioneIni
Fine = EstrazioneFin
ReDim aN(90)
If ScegliFormazione(aN) Then
Ruota = ScegliRuotaEx
Sorte = ScegliEsito
If Ruota > 0 And Sorte > 0 Then
For idEstr = Inizio To Fine
If Ruota = 11 Then
bEstrValida = False
pMax = 0
For r = 1 To 10
If Estratto(idEstr,r,1) > 0 Then bEstrValida = True
p = 0
For k = 2 To 2
If aN(Estratto(idEstr,r,k)) Then
p = p + 1
End If
Next
If p > pMax Then pMax = p
Next
If bEstrValida Then
If pMax >= Sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
Else
If Estratto(idEstr,Ruota,1) > 0 Then
p = 0
For k = 2 To 2
If aN(Estratto(idEstr,Ruota,k)) Then
p = p + 1
End If
Next
If p >= Sorte Then
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Rit = 0
Fre = Fre + 1
IncRitMax = 0
Else
Rit = Rit + 1
If Rit > RitMax Then
IncRitMax = IncRitMax + 1
RitMax = Rit
End If
End If
End If
End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
If ScriptInterrotto Then Exit For
Next
If IncRitMax > 0 Then
Set cParStat = New clsParStat
cParStat.idEstr = idEstr - 1
cParStat.RitMax = RitMax
cParStat.IncrRitMax = IncRitMax
collStoria.Add cParStat
End If
Call GestioneOutput(collStoria,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre)
Else
MsgBox "Ruota non valida"
End If
End If
End Sub
Function ScegliFormazione(aN)
Dim sFormazione
Dim k,i
sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"25.77")
ReDim aV(0)
Call SplitByChar(sFormazione,".",aV)
For k = 0 To UBound(aV)
If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then
aN(Int(aV(k))) = True
i = i + 1
End If
Next
If i > 0 Then ScegliFormazione = True
End Function
Sub GestioneOutput(coll,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre)
Dim x,y,k
Dim sFrz
Dim clsP
For k = 1 To 90
If aN(k) Then
sFrz = sFrz & Format2(k) & "."
End If
Next
sFrz = Left(sFrz,Len(sFrz) - 1)
Call Scrivi("Sulla ruota di : " & NomeRuota(Ruota))
Call Scrivi("Formazione analizzata : " & sFrz)
Call Scrivi("Da Estrazione : " & GetInfoEstrazione(Inizio))
Call Scrivi("A Estrazione : " & GetInfoEstrazione(Fine))
Call Scrivi
Call Scrivi("Ritardo : " & Rit)
Call Scrivi("RitardoMax : " & RitMax)
Call Scrivi("Frequenza : " & Fre)
Call Scrivi
Call Scrivi("Dettaglio evoluzione RitMax",True)
For Each clsP In coll
Call Scrivi("Estrazione : " & FormatSpace(clsP.idEstr,5,True) & _
" RitMax : " & FormatSpace(clsP.RitMax,5,True) & _
" InccrRitMax : " & FormatSpace(clsP.IncrRitMax,5,True))
Next
Call Scrivi
Call Scrivi("Grafico di confronto RitMax / IncRitMax",True)
Call PreparaGrafico("",0,coll.count,0,RitMax,1,5)
' prima riga
ReDim aV(coll.count,2)
For Each clsP In coll
x = x + 1
aV(x,1) = x
aV(x,2) = clsP.RitMax
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
x = 0
ReDim aV(coll.count,2)
For Each clsP In coll
x = x + 1
aV(x,1) = x
aV(x,2) = clsP.IncrRitMax
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncRitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
Function ScegliRuotaEx
Dim k
ReDim aV(12)
For k = 1 To 12
aV(k) = NomeRuota(k)
Next
ScegliRuotaEx = ScegliOpzioneMenu(aV,9)
End FunctionBene ho effettuato delle analisi Ne approfitto per dare anche una spiegazione.
Dai risultati che hai postato si vede fin da subito che la stringa degli incrementi è anomala. Il primo elemento della stringa è 3.. Già questo è sbagliato.
Il primo ritardo conosciuto è pari a 71 e lo puoi tranquillamente vedere analizzando la formazione in statistica lunghette guardando il primo risultato delle "uscite precedenti".
Secondo, il numero 71 non è riportato nel mio grafico perché in realtà si tratta del primo ritardo in assoluto ...quindi non puoi definirlo "incremento del ritardo" se è il primo in assoluto.
Terzo elemento (il più importante), a te il ritardo massimo storico risulta 249...ma in realtà è 223...e lo vedi anche dall'immagine postata. Questo succede semplicemente perché nel tuo script riconosce, se esiste, l'incremento del ritardo come valore massimo di ritardo storico ma è una concezione sbagliata. Come puoi dire che 249 è il ritardo massimo "STORICO" se ancora non si è sfaldato e non è iniziato un nuovo conteggio?
Verifica il tuo script. Ci sono molte anomalie di calcolo.
Per completezza e correttezza posto un piccolo script eseguibile in SpazioMetria con la concezione del tuo ma con i calcoli corretti, così comprendi immediatamente cosa ti ho detto prima.
Incolla e manda in run
Codice:Option Explicit Class clsParStat Dim idEstr Dim RitMax Dim IncrRitMax End Class Sub Main Dim idEstr,Ruota,Sorte Dim Inizio,Fine Dim k,p,i,r,pMax Dim Rit,RitMax,IncRitMax,Fre Dim collStoria Dim cParStat Dim bEstrValida Set collStoria = GetNewCollection Inizio = EstrazioneIni Fine = EstrazioneFin ReDim aN(90) If ScegliFormazione(aN) Then Ruota = ScegliRuotaEx Sorte = ScegliEsito If Ruota > 0 And Sorte > 0 Then For idEstr = Inizio To Fine If Ruota = 11 Then bEstrValida = False pMax = 0 For r = 1 To 10 If Estratto(idEstr,r,1) > 0 Then bEstrValida = True p = 0 For k = 2 To 2 If aN(Estratto(idEstr,r,k)) Then p = p + 1 End If Next If p > pMax Then pMax = p Next If bEstrValida Then If pMax >= Sorte Then If IncRitMax > 0 Then Set cParStat = New clsParStat cParStat.idEstr = idEstr - 1 cParStat.RitMax = RitMax cParStat.IncrRitMax = IncRitMax collStoria.Add cParStat End If Rit = 0 Fre = Fre + 1 IncRitMax = 0 Else Rit = Rit + 1 If Rit > RitMax Then IncRitMax = IncRitMax + 1 RitMax = Rit End If End If End If Else If Estratto(idEstr,Ruota,1) > 0 Then p = 0 For k = 2 To 2 If aN(Estratto(idEstr,Ruota,k)) Then p = p + 1 End If Next If p >= Sorte Then If IncRitMax > 0 Then Set cParStat = New clsParStat cParStat.idEstr = idEstr - 1 cParStat.RitMax = RitMax cParStat.IncrRitMax = IncRitMax collStoria.Add cParStat End If Rit = 0 Fre = Fre + 1 IncRitMax = 0 Else Rit = Rit + 1 If Rit > RitMax Then IncRitMax = IncRitMax + 1 RitMax = Rit End If End If End If End If Call AvanzamentoElab(Inizio,Fine,idEstr) If ScriptInterrotto Then Exit For Next If IncRitMax > 0 Then Set cParStat = New clsParStat cParStat.idEstr = idEstr - 1 cParStat.RitMax = RitMax cParStat.IncrRitMax = IncRitMax collStoria.Add cParStat End If Call GestioneOutput(collStoria,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre) Else MsgBox "Ruota non valida" End If End If End Sub Function ScegliFormazione(aN) Dim sFormazione Dim k,i sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"25.77") ReDim aV(0) Call SplitByChar(sFormazione,".",aV) For k = 0 To UBound(aV) If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then aN(Int(aV(k))) = True i = i + 1 End If Next If i > 0 Then ScegliFormazione = True End Function Sub GestioneOutput(coll,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre) Dim x,y,k Dim sFrz Dim clsP For k = 1 To 90 If aN(k) Then sFrz = sFrz & Format2(k) & "." End If Next sFrz = Left(sFrz,Len(sFrz) - 1) Call Scrivi("Sulla ruota di : " & NomeRuota(Ruota)) Call Scrivi("Formazione analizzata : " & sFrz) Call Scrivi("Da Estrazione : " & GetInfoEstrazione(Inizio)) Call Scrivi("A Estrazione : " & GetInfoEstrazione(Fine)) Call Scrivi Call Scrivi("Ritardo : " & Rit) Call Scrivi("RitardoMax : " & RitMax) Call Scrivi("Frequenza : " & Fre) Call Scrivi Call Scrivi("Dettaglio evoluzione RitMax",True) For Each clsP In coll Call Scrivi("Estrazione : " & FormatSpace(clsP.idEstr,5,True) & _ " RitMax : " & FormatSpace(clsP.RitMax,5,True) & _ " InccrRitMax : " & FormatSpace(clsP.IncrRitMax,5,True)) Next Call Scrivi Call Scrivi("Grafico di confronto RitMax / IncRitMax",True) Call PreparaGrafico("",0,coll.count,0,RitMax,1,5) ' prima riga ReDim aV(coll.count,2) For Each clsP In coll x = x + 1 aV(x,1) = x aV(x,2) = clsP.RitMax Next Call DisegnaLineaGrafico(aV,vbBlue,"RitMax") x = 0 ReDim aV(coll.count,2) For Each clsP In coll x = x + 1 aV(x,1) = x aV(x,2) = clsP.IncrRitMax Next Call DisegnaLineaGrafico(aV,vbRed,"IncRitMax") ' scrive grafico nell'output Call InserisciGrafico End Sub Function ScegliRuotaEx Dim k ReDim aV(12) For k = 1 To 12 aV(k) = NomeRuota(k) Next ScegliRuotaEx = ScegliOpzioneMenu(aV,9) End Function
Spero di aver chiarito ogni dubbio e soprattutto di essere stato di aiuto
In sostanza il tuo programma non ha errori e il mio script non mi rileva i giusti parametri? Lo script soprastante è impostato per analizzare di default la seconda posizione? Grazie ok
poichè siamo degli incontentabili ,potevi mettere un copia e incollacaro Silop ti abbiamo accontentato , in extrama ratio quando non funziona niente ...
vedi che bella icona abbiamo messo
Vedi l'allegato 2227196
