script

[solare]

Se potete provarlo a me dopo l'avvio mostra pagina bianca senza risultati. Grazie

Option Explicit

Class clsCombinazione

Public aNumeri ' numeri che compongono la combinazione
Public aRitardi ' i ritardi negli ultimi cicli voluti dall'utente
Public aRitardiGlob ' ritardi globali della combinazione calcolati da 1 al maxRange
Public aIdEstrRitardi ' contiene gli id delle estrazioni alle quali si è calcolato il ritardo
Public nIdPrimoRitCons ' indice per l'array aRitardiGlob che indica il punto di inizio della serie consecutiva
Public nIdUltimoRitCons' indice per l'array aRitardiGlob che indica il punto di fine della serie consecutiva
Public nSommaUltim5
Public bUltimi5ritMaggDi11
Public bRitCorrMinoreDi12
Public Ruota
Public nRitConsecutiviMax
Public nIdEstrIni ' id Estrazione da cui parrte la serie consecutiva storica
Public nIdEstrFin ' id Estrazione in cui termina la serie consecutiva storica



Sub SetNumeriFromRigaCsv(sRiga)
Dim k
ReDim aV(0)
Call SplitByChar(sRiga,";",aV)
ReDim aNumeri(10)

For k = 1 To 10
If IsNumeric(aV(k)) Then
aNumeri(k) = CInt(aV(k))
Else

aNumeri(k) = 0
End If
Next

End Sub
Sub CalcolaTuttiRitardi(fine,Sorte,aRuote)




Dim nCicli
Dim nEstrFine

Dim k
Dim nMax


nEstrFine = fine
ReDim aRitardiGlob(nMax)
ReDim aIdEstrRitardi(nMax)


nCicli = 0

Do
nCicli = nCicli + 1
If nCicli > nMax Then
nMax = nMax + 100
ReDim Preserve aRitardiGlob(nMax)
ReDim Preserve aIdEstrRitardi(nMax)
End If

aRitardiGlob(nCicli) = RitardoCombinazione(aRuote,aNumeri,Sorte,nEstrFine)
aIdEstrRitardi(nCicli) = nEstrFine


nEstrFine = nEstrFine - aRitardiGlob(nCicli) - 1

If ScriptInterrotto Then Exit Do

Loop While nEstrFine > 0
ReDim Preserve aRitardiGlob(nCicli)
ReDim Preserve aIdEstrRitardi(nCicli)




End Sub

Sub CalcolaRitardi(fine,Sorte,aRuote,RitardoMinimo,CicliDiRitardo,UltimiRitardiDaConsiderare)



Dim nCicli
Dim k
Dim nRitTrovati

Call CalcolaTuttiRitardi(fine,Sorte,aRuote)
Call GetRitardiConsecMaggioriDiX(RitardoMinimo)


nCicli = CicliDiRitardo
nRitTrovati = UBound(aRitardiGlob)

ReDim aRitardi(CicliDiRitardo)




For k = 1 To CicliDiRitardo

If k <= nRitTrovati Then
aRitardi(nCicli) = aRitardiGlob(k)
nCicli = nCicli - 1
Else
Exit For
End If
If ScriptInterrotto Then Exit For

Next

bUltimi5ritMaggDi11 = True
For k =(CicliDiRitardo - UltimiRitardiDaConsiderare) To(CicliDiRitardo - 1)
nSommaUltim5 = nSommaUltim5 +(aRitardi(k))

If aRitardi(k) <= RitardoMinimo Then
bUltimi5ritMaggDi11 = False

End If
Next

If aRitardi(CicliDiRitardo) <= RitardoMinimo Then
bRitCorrMinoreDi12 = True
Else
bRitCorrMinoreDi12 = False
End If
End Sub


Sub GetRitardiConsecMaggioriDiX(RitardoMinimo)

Dim k
Dim nConsec
Dim nConsecMax
Dim nIdEstrA,nIdEstrB
Dim nIdRitA,nIdRitB
Dim nIdEstrATmp,nIdEstrBTmp
Dim nIdRitATmp,nIdRitBTmp





For k = UBound(aRitardiGlob) To 1 Step - 1

If aRitardiGlob(k) > RitardoMinimo Then
nIdEstrATmp = aIdEstrRitardi(k)
nIdRitATmp = k
nConsec = 0
Do While aRitardiGlob(k) > RitardoMinimo
nConsec = nConsec + 1
nIdEstrBTmp = aIdEstrRitardi(k)
nIdRitBTmp = k
k = k - 1
If k <= 0 Then Exit Do
Loop

If nConsec > nConsecMax Then

nConsecMax = nConsec
nIdEstrA = nIdEstrATmp
nIdEstrB = nIdEstrBTmp
nIdRitA = nIdRitATmp
nIdRitB = nIdRitBTmp
End If

k = k + 1
End If
If ScriptInterrotto Then Exit For

Next



nRitConsecutiviMax = nConsecMax
nIdEstrIni = nIdEstrB
nIdEstrFin = nIdEstrA

nIdPrimoRitCons = nIdRitB
nIdUltimoRitCons = nIdRitA



End Sub


End Class
Sub Main


Dim CollDecine
Dim Ruota,sorte
Dim RangeFine
Dim RitardoMinimo
Dim MaxDaMostrare
Dim CicliDiRitardo ' il numero dei ritardi da calcolare compreso l'ultimo
Dim UltimiRitardiDaConsiderare ' quanti ritardi considerare (escluso ultimo perche rit corrente)


Set CollDecine = GetNewCollection

sorte = 2 ' ambo

RitardoMinimo = 11
RitardoMinimo = CInt(InputBox("Inserire il valore per il ritardo naturale","Ritardo naturale",RitardoMinimo)) ' per la gestione degli ultimi 5 ritardi

CicliDiRitardo = 11
CicliDiRitardo = CInt(InputBox("Inserire il valore per i cicli di ritardo a ritroso da calcolare","Cicli di ritardo",CicliDiRitardo)) ' per la gestione degli ultimi 5 ritardi

UltimiRitardiDaConsiderare = 5
UltimiRitardiDaConsiderare = CInt(InputBox("Inserire il valore per identificare la quantita di ritardi (escluso l'ultimo che è il corrente) da valutare per la selezione","Cicli di ritardo",UltimiRitardiDaConsiderare)) ' per la gestione degli ultimi 5 ritardi


MaxDaMostrare = 100 ' le prime 100 combinazioni che hanno i 5 ultimi rit magiori di 11 ordinate per somma rit ultimi 5



ReDim aRuote(1)
ReDim abRuote(12)
Call ScegliRuote(aRuote,abRuote)

RangeFine = EstrazioneFin

If CicliDiRitardo - UltimiRitardiDaConsiderare <= 0 Then
MsgBox "I cicli di ritardo devono essere maggiori del valore che specifica quanti degli ultimi ritardi considerare"
Exit Sub
End If

If CicliDiRitardo > 0 And UltimiRitardiDaConsiderare > 0 And RitardoMinimo > 0 Then

For Ruota = 1 To 12
If abRuote(Ruota) Then
If Ruota <> 11 Then


Call AlimentaCollectionDecine(CollDecine,RangeFine,sorte,Ruota,RitardoMinimo,CicliDiRitardo,UltimiRitardiDaConsiderare)


End If
End If
Next

If CollDecine.count > 0 Then
Call Messaggio("Ordinamento in corso.....")
Call OrdinaItemCollection(CollDecine,"nSommaUltim5")

Call Messaggio("Creazione tabella riepilogativa.....")
Call CreaOutput(CollDecine,MaxDaMostrare,RitardoMinimo,CicliDiRitardo,UltimiRitardiDaConsiderare)

Call OrdinaItemCollection(CollDecine,"nRitConsecutiviMax")

Call Messaggio("Creazione tabella riepilogativa cicli consec max.....")
Call CreaOutputCicliConsecMax(CollDecine,MaxDaMostrare,RitardoMinimo,UltimiRitardiDaConsiderare)



End If
End If


End Sub

Sub CreaOutput(coll,MaxDaMostrare,RitardoMinimo,CicliDiRitardo,UltimiRitardiDaConsiderare)



Dim k,i
Dim clsDecina
Dim nColonne

nColonne = 3 + CicliDiRitardo + 2

ReDim aTitoli(nColonne)

aTitoli(1) = "Numero"
aTitoli(2) = " Combinazione "
aTitoli(3) = "Ruota "
For k = 1 To CicliDiRitardo - 1
aTitoli(k + 3) = "R" &(k) & " "
Next
aTitoli(nColonne - 2) = "Ritardo"
aTitoli(nColonne - 1) = "S. R" &(CicliDiRitardo - UltimiRitardiDaConsiderare) & "-R" &(CicliDiRitardo - 1)
aTitoli(nColonne) = "CONS MAX"




Call InitTabella(aTitoli,vbYellow)

For Each clsDecina In coll

If clsDecina.bUltimi5ritMaggDi11 Then
If clsDecina.bRitCorrMinoreDi12 Then

i = i + 1

ReDim aValori(nColonne)
aValori(1) = i
aValori(2) = StringaNumeri(clsDecina.aNumeri)
aValori(3) = NomeRuota(clsDecina.Ruota)
For k = 1 To CicliDiRitardo

aValori(k + 3) = clsDecina.aRitardi(k)
Next
aValori(nColonne - 1) = clsDecina.nSommaUltim5
aValori(nColonne) = clsDecina.nRitConsecutiviMax


Call AddRigaTabella(aValori,,"right")

If i >= MaxDaMostrare Then Exit For
End If
End If
If ScriptInterrotto Then Exit For

Next

Call Scrivi("Sono mostrate le combinazioni i cui ultimi " & UltimiRitardiDaConsiderare & _
" ritardi sono maggiori di " & RitardoMinimo & " ordinate per somma ultimi ritardi",True)


Call Scrivi

Call CreaTabella





End Sub
Sub CreaOutputCicliConsecMax(coll,MaxDaMostrare,RitardoMinimo,UltimiRitardiDaConsiderare)




Dim k,i
Dim clsDecina
Dim nColonne
Dim idCol
Dim idRit
Dim CicliDiRitardo


Set clsDecina = coll(1)
CicliDiRitardo = clsDecina.nRitConsecutiviMax '(clsDecina.nIdUltimoRitCons + 1) - clsDecina.nIdPrimoRitCons
nColonne = 3 + CicliDiRitardo + 3

ReDim aTitoli(nColonne)

aTitoli(1) = "Numero"
aTitoli(2) = " Combinazione "
aTitoli(3) = "Ruota "
For k = 1 To CicliDiRitardo
aTitoli(k + 3) = "R" &(k) & " "
Next

aTitoli(nColonne - 2) = "Data Inizio "
aTitoli(nColonne - 1) = "Data Fine "

aTitoli(nColonne) = "CONS MAX"




Call InitTabella(aTitoli,vbYellow)

For Each clsDecina In coll


i = i + 1

ReDim aValori(nColonne)
aValori(1) = i
aValori(2) = StringaNumeri(clsDecina.aNumeri)
aValori(3) = NomeRuota(clsDecina.Ruota)
idCol = 3
idRit = clsDecina.nIdPrimoRitCons

For k = 1 To CicliDiRitardo ' clsDecina.nIdPrimoRitCons To clsDecina.nIdUltimoRitCons
idCol = idCol + 1

'If idRit <= UBound(clsDecina.aRitardiGlob) Then
aValori(idCol) = clsDecina.aRitardiGlob(idRit)
idRit = idRit + 1
'End If

Next
aValori(nColonne - 1) = DataEstrazione(clsDecina.nIdEstrIni)
aValori(nColonne - 2) = DataEstrazione(clsDecina.nIdEstrFin)
aValori(nColonne) = clsDecina.nRitConsecutiviMax


Call AddRigaTabella(aValori,,"right")

If i >= MaxDaMostrare Then Exit For

If ScriptInterrotto Then Exit For


Next

Call Scrivi("Sono mostrate le combinazioni che nel corso del periodo analizzato" & vbCrLf & _
" hanno avuto i maggiori cicli di ritardo consecutivo superiore di " & _
RitardoMinimo & " ordinate per cicli di ritardo consecutivo",True)

Call Scrivi("N.B. I ritardi mostrati sono quelli che hanno generato la consecutività")



Call Scrivi

Call CreaTabella





End Sub

Sub AlimentaCollectionDecine(coll,fine,Sorte,Ruota,RitardoMinimo,CicliDiRitardo,UltimiRitardiDaConsiderare)


Dim sPercorsoFileCsv
Dim k
Dim clsDecina

ReDim aRuote(1)

aRuote(1) = Ruota


sPercorsoFileCsv = GetDirectoryAppData & "decine.csv"

ReDim aLinee(0)
If LeggiRigheFileDiTesto(sPercorsoFileCsv,aLinee) Then
Call Messaggio(NomeRuota(Ruota) & " - Lettura combinazioni e calcolo ritardo... Attendere")
For k = 1 To UBound(aLinee)

Set clsDecina = New clsCombinazione

clsDecina.Ruota = Ruota

Call clsDecina.SetNumeriFromRigaCsv(aLinee(k))
Call clsDecina.CalcolaRitardi(fine,Sorte,aRuote,RitardoMinimo,CicliDiRitardo,UltimiRitardiDaConsiderare)

coll.Add clsDecina

Call AvanzamentoElab(1,UBound(aLinee),k)
Next
End If


End Sub