Option Explicit
' Non Si garantisce che la statistica riportata sia esatta
' la funzione degli incrementi è scritta dal grandissimo LuigiB
'
Sub Main
Dim sFile:sFile = "C:\Users\MyName\Documents\Colonne\Colonne21.txt" ' inserire il prorio percorso'
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFile,aRighe)
If Not FileEsistente(sFile)Then Exit Sub
Dim aN:aN = Split("0." & aRighe(0),".")' questo cambia se le lunghette hanno gia lo zero al primo posto e il carattere separatore è diverso
Dim nCls: nCls = UBound(aN)
Dim aR(1):aR(1) = ScegliRuota
Dim nRu:nRu=1 :If aR(1)=11 Then nRu=11
Dim nSorte:nSorte = 2
Dim iAnnoIni:iAnnoIni = 8117
Dim iAnnoFin:iAnnoFin = EstrazioneFin
Dim iNumEstr:iNumEstr =(iAnnoFin - iAnnoIni) + 1
Dim iCicloTeo:iCicloTeo = CicloTeorico(nCls,nSorte,Int(nRu))
Dim iPresTeoriche:iPresTeoriche = Round(Dividi(iNumEstr,iCicloTeo),2)
Scrivi "Range esaminato: " & iAnnoIni & "-" & iAnnoFin & " ( " & iNumEstr & " )"
Scrivi "Ruota aNalizzata: "& NomeRuota(aR(1))
Scrivi "Il Ciclo Teorico di una formazione di classe " & nCls & " per " & NomeSorte(nSorte) & " è " & iCicloTeo & " estrazioni"
Scrivi "Presenze teoriche della formazioni = (NumEstr/CicloTeorico): " & iPresTeoriche
Scrivi
Scrivi "CsPos | FORMAZIONE |RIT.CR|RIT.MX|CS.COP| STRINGA INCREMENTI | UL INC |Riga analizzata(inizo 0)"
Call ResetTimer
Dim Rit,RitMax,nCsCop,mStrIncRitSto,mUltimoIncrRitMax
Dim i,j,nTro ' variabili contatore
For i = 0 To UBound(aRighe)
aN = Split("0." & aRighe(i),".")
Call Messaggio("Num Formazione: " & i + 1 & " Filtrate: " & nTro)
ReDim aRit(0),aId(0)
Call ElencoRitardiTurbo(aN,aR,nSorte,iAnnoIni,iAnnoFin,aRit,aId)
nCsCop = UBound(aRit) - 1
Rit = aRit(nCsCop + 1)
RitMax = MassimoV(aRit,1,nCsCop)
' iserisco i possibili filtri da remmare quelli non desiderati
'---------------------------------------------------------------
' If nCsCop >= (iPresTeoriche) Then ' se la lunghetta rispetta il ciclo teorico
' If Rit=RitMax Then ' SE IL RC è UGUALE AL RIT MAX
If nCsCop >=(iPresTeoriche) And Rit = RitMax Then ' SE LA lunghetta rispetta il ciclo teorico e il RC e= al ritardo max
nTro = nTro + 1
Call AlimentaVettoreIncrRitMax(aRit,aId,mStrIncRitSto,mUltimoIncrRitMax)
Scrivi FormatSpace(nTro,6,1) & "| " & StringaNumeri(aN,,True) & " | " & _
FormatSpace(Rit,4,1) & " | " & FormatSpace(RitMax,4,1) & " | " & _
FormatSpace(nCsCop,4,1) & " | " & FormatSpace(mStrIncRitSto,45,1) & " | " & FormatSpace(mUltimoIncrRitMax,6,1)&" | "&i
End If
If ScriptInterrotto Then Exit For
Next ' i
Scrivi "Formazioni Filtrate : " & nTro & " in " & TempoTrascorso
End Sub
Sub AlimentaVettoreIncrRitMax(aElencoRit,aIdEstrElencoRit,mStrIncRitSto,mUltimoIncrRitMax)
Dim nRitMax,nIncr,nId,k
nId = 0
' inizializzo il vettore a 0 elementi
ReDim aElencoIncrRitMax(0)
ReDim aIdEstrIncrRitMax(0)
ReDim aRitardiAllIncremento(0)
' ciclo sul vettore dei ritardi
For k = 1 To UBound(aElencoRit)
' se il ritardo corrente supera il ritmax attuale..
If aElencoRit(k) > nRitMax Then
If nRitMax > 0 Then
' se il ritmax attuale è >0 (ivvero ne esiste uno)
' calcolo di quanto si è incrementato
nIncr = aElencoRit(k) - nRitMax
' incremento il contatore dei valori trovati
nId = nId + 1
' ridimensiono il vettore mantenendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aElencoIncrRitMax(nId)
' memorizzo il valore
aElencoIncrRitMax(nId) = nIncr
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aIdEstrIncrRitMax(nId)
' memorizzo l'id dell'estrazione dove si è avuto l'incremento
aIdEstrIncrRitMax(nId) = aIdEstrElencoRit(k)
' ridimensiono il vettore mantnendo i valori precedenti ma
' aggiungendone uno
ReDim Preserve aRitardiAllIncremento(nId)
' memorizzo il valore del ritardo all'id dell'estrazione dove si è avuto l'incremento
aRitardiAllIncremento(nId) = aElencoRit(k)
End If
nRitMax = aElencoRit(k)
End If
Next
mStrIncRitSto = StringaNumeri(aElencoIncrRitMax,,True)
mUltimoIncrRitMax = aElencoIncrRitMax(UBound(aElencoIncrRitMax))
End Sub