modifica script

[adispo2000]

potete modificarlo per le cadenze?

Option Explicit
Class clsCoppiaFormazioni
Public Ruota
Public cFrz1
Public cFrz2

End Class
Class clsColonna
Dim aNumeriOrig ' numeri della colonna matrice
Dim NumeriSostituiti(10) ' numeri della colonna con le sostituzioni prese dal pronostico
Sub SetNumeri(sNum)
Dim av,k,e
ReDim aNumeriOrig(10)
av = Split(sNum,";")
For k = 0 To UBound(av)
If isNumeroValidoLotto(Int(av(k))) Then
e = e + 1
aNumeriOrig(e) = Int(av(k))
End If
Next
End Sub
Sub ConvertiColonna(aLunghetta,aRetCol)
Dim k
ReDim aRetCol(UBound(aNumeriOrig))
For k = 1 To UBound(aRetCol)
aRetCol(k) = aLunghetta(aNumeriOrig(k))
Next
End Sub
End Class
Class clsRuota
Private m_CollFormazioni
Private m_Ruota
Sub Class_Initialize
Set m_CollFormazioni = GetNewCollection
End Sub
Public Property Let Ruota(v)
m_Ruota = v
End Property
Public Property Get Ruota
Ruota = m_Ruota
End Property
Public Property Get CollFormazioni
Set CollFormazioni = m_CollFormazioni
End Property
Public Property Set CollFormazioni(NewValue)
m_CollFormazioni = NewValue
End Property
Sub AddFormazione(cFrz)
m_CollFormazioni.Add cFrz
End Sub
End Class
Class clsFormazione
Private aNum
Private mRitardo
Sub SetNumeri(sNum)
Dim av,k,e
ReDim aNum(90)
av = Split(sNum,";")
For k = 0 To UBound(av)
If isNumeroValidoLotto(Int(av(k))) Then
e = e + 1
aNum(e) = Int(av(k))
End If
Next
ReDim Preserve aNum(e)
End Sub
Sub CalcRitardi(idEstr,nSorte)

mRitardo = RitardoCombinazioneSE(aNum,nSorte,idEstr)
End Sub
Function RitardoEstrattoSE(n,idEstr)
ReDim aN(1)
aN(1) = n
RitardoEstrattoSE = RitardoCombinazioneSE(aN,1,idEstr)
End Function
Sub PrendiNumeriPiuRecenti(nQuantita,aRetNum,idPrimoElem,idEstr,bDettagli)
Dim k
ReDim aE(10,2)
For k = 1 To 10
aE(k,1) = aNum(k)
aE(k,2) = RitardoEstrattoSE(aNum(k),idEstr)
Next
Call OrdinaMatrice(aE,1,2)
If bDettagli Then
For k = 1 To 10
If k <= nQuantita Then
Scrivi Format2(aE(k,1)) & " Rit : " & aE(k,2),True
Else
Scrivi Format2(aE(k,1)) & " Rit : " & aE(k,2),False
End If
Next
End If
For k = 1 To nQuantita
aRetNum((idPrimoElem - 1) + k) = aE(k,1)
Next
End Sub
Sub ScriviNumeri
Call Scrivi(StringaNumeri(aNum) & " Rit : " & mRitardo)
End Sub
Public Property Get Ritardo
Ritardo = mRitardo
End Property
End Class
Sub Main
Dim CollRuote,CollForm
Dim CollSistema
Dim idEstr,RitMin,RitMax
Dim cFrz1,cFrz2
Dim nSorte

Dim aRegistro
Dim nTotCasi,nTotVincenti
Dim nUltima
Dim bDettagli
Dim nColpiUsati

Dim aLunghetta
Dim nColpiAttesa
Dim cCoppiaFrz
Dim Inizio,Fine

ReDim aQPerEsito(6)



bDettagli = True


nColpiAttesa = Int(InputBox("Gioca le combinazioni che hanno superato il ritardo specificato di","Colpi attsa",0))
nSorte = 2
RitMin = 10
RitMax = 18




Fine = EstrazioniArchivioSE
Inizio = Fine - 499


Call AlimentaCollRuote(CollRuote)
Call AlimentaRegistro(aRegistro)
Call AlimentaColonneSistema(CollSistema)
For idEstr = Inizio To Fine
Scrivi "Estrazione : " & GetInfoEstrazioneSE(idEstr)
Call CalcolaRitardi(CollRuote,idEstr,nSorte)

If TrovaFormazioniDaGiocare(CollRuote,CollForm,RitMin,RitMax) Then
For Each cCoppiaFrz In CollForm
Call VerificaLunghetta(cCoppiaFrz.cFrz1,cCoppiaFrz.cFrz2,idEstr,nSorte,aRegistro,nTotCasi,nTotVincenti,aQPerEsito,bDettagli,nColpiUsati,aLunghetta)
If nColpiUsati > nColpiAttesa Then

Call GiocaLunghetta(CollSistema,aLunghetta,nSorte,idEstr,nColpiUsati,nColpiAttesa,15)
End If

Next
Else
Scrivi "NESSUNA PREVISIONE"
Scrivi


End If
Call AvanzamentoElab(Inizio,Fine,idEstr)
nUltima = idEstr
If ScriptInterrotto Then Exit For
Next
Call ScriviRegistro(aQPerEsito,aRegistro,nTotCasi,nTotVincenti,Inizio,nUltima)


End Sub
Sub AlimentaRegistro(aRegistro)
ReDim aRegistro(6,3)
aRegistro(1,1) = 1 :aRegistro(1,2) = 3
aRegistro(2,1) = 4 :aRegistro(2,2) = 5
aRegistro(3,1) = 6 :aRegistro(3,2) = 7
aRegistro(4,1) = 8 :aRegistro(4,2) = 10
aRegistro(5,1) = 11 :aRegistro(5,2) = 13
aRegistro(6,1) = 14 :aRegistro(6,2) = 10000000

End Sub
Sub AlimentaCollRuote(CollRuote)

Dim cFrz,cRuota
Set CollRuote = GetNewCollection

Set cRuota = New clsRuota

Set cFrz = New clsFormazione
cFrz.SetNumeri("1;2;3;4;5;6;7;8;9;10")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("11;12;13;14;15;16;17;18;19;20")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("21;22;23;24;25;26;27;28;29;30")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("31;32;33;34;35;36;37;38;39;40")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("41;42;43;44;45;46;47;48;49;50")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("51;52;53;54;55;56;57;58;59;60")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("61;62;63;64;65;66;67;68;69;70")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("71;72;73;74;75;76;77;78;79;80")
Call cRuota.AddFormazione(cFrz)
Set cFrz = New clsFormazione
cFrz.SetNumeri("81;82;83;84;85;86;87;88;89;90")
Call cRuota.AddFormazione(cFrz)
CollRuote.Add cRuota

End Sub

Sub CalcolaRitardi(collRuote,idEstr,nSorte)
Dim cRuota,cFrz
For Each cRuota In collRuote
For Each cFrz In cRuota.CollFormazioni
Call cFrz.CalcRitardi(idEstr,nSorte)
Call cFrz.ScriviNumeri
Next
Scrivi
Next
End Sub
Function TrovaFormazioniDaGiocare(CollRuote,CollForm,RitMin,RitMax)
Dim cRuota,cFrz
Dim nTrovate
Dim cCoppiaFrz

Set CollForm = GetNewCollection


For Each cRuota In CollRuote
nTrovate = 0
Set cCoppiaFrz = New clsCoppiaFormazioni


For Each cFrz In cRuota.CollFormazioni
If cFrz.Ritardo >= RitMin And cFrz.Ritardo <= RitMax Then
nTrovate = nTrovate + 1
Select Case nTrovate
Case 1
Set cCoppiaFrz.cFrz1 = cFrz
Case 2
Set cCoppiaFrz.cFrz2 = cFrz
Case Else
Exit For
End Select
End If
Next
If nTrovate = 2 Then
CollForm.Add cCoppiaFrz
'RuotaDiGioco = cRuota.ruota
'TrovaFormazioniDaGiocare = True
'Exit Function
End If
Next
TrovaFormazioniDaGiocare = CollForm.count

End Function
Sub VerificaLunghetta(cFrz1,cFrz2,idEstr,nSorte,aRegistro,nTotCasi,nTotVincenti,aQPerEsito,bDettagli,nRetColpiDiGioco,aNumLunghetta)
Dim sEsito,nRetColpi,sRetEstratti
ReDim aNumLunghetta(14)
nTotCasi = nTotCasi + 1
If bDettagli Then

Call Scrivi("Numeri ricavati all'estrazione " & GetInfoEstrazioneSE(idEstr))

Scrivi
End If

If bDettagli Then cFrz1.ScriviNumeri
Call cFrz1.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr,bDettagli)
If bDettagli Then cFrz2.ScriviNumeri
Call cFrz2.PrendiNumeriPiuRecenti(7,aNumLunghetta,8,idEstr,bDettagli)

If bDettagli Then Call Scrivi("Lunghetta : " & StringaNumeri(aNumLunghetta))

If VerificaEsitoSE(aNumLunghetta,idEstr + 1,nSorte,,sEsito,nRetColpi,sRetEstratti) Then
Call RegistraVincita(aRegistro,nRetColpi,sEsito,aQPerEsito)
If bDettagli Then Scrivi sEsito & " colpi : " & nRetColpi & " Numeri : " & sRetEstratti
nTotVincenti = nTotVincenti + 1
Else
If bDettagli Then Scrivi "Senza esito" & " colpi : " & nRetColpi
End If
nRetColpiDiGioco = nRetColpi
If bDettagli Then
Scrivi
Scrivi
End If
End Sub
Sub RegistraVincita(aRegistro,nColpi,sEsito,aQPerEsito)
Dim k
Select Case sEsito
Case "Estratto"
aQPerEsito(1) = aQPerEsito(1) + 1
Case "Ambo"
aQPerEsito(2) = aQPerEsito(2) + 1
Case "Terno"
aQPerEsito(3) = aQPerEsito(3) + 1
Case "Quaterna"
aQPerEsito(4) = aQPerEsito(4) + 1
Case "Cinquina"
aQPerEsito(5) = aQPerEsito(5) + 1
Case "Sestina"
aQPerEsito(6) = aQPerEsito(6) + 1

End Select
For k = 1 To UBound(aRegistro)
If nColpi >= aRegistro(k,1) And nColpi <= aRegistro(k,2) Then
aRegistro(k,3) = aRegistro(k,3) + 1
End If
Next
End Sub
Sub ScriviRegistro(aQPerEsito,aRegistro,nTotCasi,nTotVincenti,Inizio,fine)
Dim k
Scrivi
Scrivi "Resoconto del metodo"
Scrivi "Estrazione inizio : " & GetInfoEstrazioneSE(Inizio)
Scrivi "Estrazione fine : " & GetInfoEstrazioneSE(fine)
Scrivi "Casi totali : " & nTotCasi
Scrivi "Casi vincenti : " & nTotVincenti & " (" & Round(ProporzioneX(nTotVincenti,nTotCasi,100),3) & "%" & ")"
Scrivi
Dim aD
aD = Array("","Colpi Min","Colpi Max","Vincenti","Perc")
Call InitTabella(aD,vbBlue,,,vbWhite)
For k = 1 To UBound(aRegistro)
aD(1) = aRegistro(k,1)
aD(2) = aRegistro(k,2)
aD(3) = aRegistro(k,3)
aD(4) = Round(ProporzioneX(aRegistro(k,3),nTotVincenti,100),3)
Call AddRigaTabella(aD)
Next
Call CreaTabella
Scrivi
aD = Array("","Sorte","Quantita","Perc")
Call InitTabella(aD,vbBlue,,,vbWhite)
For k = 1 To 5
aD(1) = NomeSorte(k)
aD(2) = aQPerEsito(k)
aD(3) = Round(ProporzioneX(aD(2),nTotVincenti,100),3)
Call AddRigaTabella(aD)
Next
Call CreaTabella
End Sub
Sub AlimentaColonneSistema(coll)
Set coll = GetNewCollection



Call AddColonna(coll,"1;2;3;8;9;10")
Call AddColonna(coll,"1;4;5;8;11;12")
Call AddColonna(coll,"1;6;7;8;13;14")
Call AddColonna(coll,"2;4;6;9;11;13")
Call AddColonna(coll,"2;5;7;9;12;14")
Call AddColonna(coll,"3;4;7;10;11;14")
Call AddColonna(coll,"3;5;6;10;12;13")






End Sub
Sub AddColonna(coll,sNumeri)
Dim clsCol
Set clsCol = New clsColonna
clsCol.SetNumeri(sNumeri)
coll.Add clsCol
End Sub
Sub GiocaLunghetta(CollSistema,aLunghetta,nSorte,idEstr,nColpiUsati,nColpiAttesa,nColpiDaGiocare)
Dim idG,k
Dim cCol
Dim aN


Scrivi "Da giocare a partire all'estrazione " & idEstr + nColpiAttesa + 1



For Each cCol In CollSistema
idG = idG + 1
Call cCol.ConvertiColonna(aLunghetta,aN)
Call Scrivi(StringaNumeri(aN,,True))

Next

Scrivi String(50,"-")



End Sub

 

[claudio8]

Voglio fare un regalo a tutti .

Giggio hai ragione . Ma la statistica dei ritardi viene fatta su 6 numeri della combinazione del super enalotto o su 6 numeri più il Jolly ? Ciao Eugenio

forum.lottoced.com

leggi qui.