Novità

Voglio fare un regalo a tutti .

i legend

Premium Member
🤣🤣🤣🤣🤣
Mi hai fatto ricordare anche un mio vecchio capo . Sempre disponibile a far lavorare gli altri però 🤣🤣🤣🤣😂
 

Alien.

Advanced Premium Member
A.....benissimo...allora da domani fai le valigie...........sei licenziato.


stanlio_e_ollio_che_ridono.gif
 

genios

Advanced Member >PLATINUM<
:):):):):):):) Allora cominciate a capire quali sono le qualità dei capi e quelle dei sottoposti :) :) :) :) :) :) Giggio non ci credo che al super enalotto in 6 estrazioni non da dei 2 o dei 3 .
 

Giggio

Super Member >PLATINUM<
ok ok .. com si dice leviamoci la sete col prosciutto , per la serie basta che funziona ecco lo script modificato per il superenalotto.
Piccola nota il range dl ritardo va abbassato io ho messo 10/18 senno non trova proprio niente da giocare

Codice:
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)
            
         Next
      Else
         Scrivi    "NESSUNA PREVISIONE"
         
      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
   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(13)
   nTotCasi = nTotCasi + 1
   If bDettagli Then
      Call Scrivi("Numeri ricavati all'estrazione " & GetInfoEstrazioneSE(idEstr)) 
      
      Scrivi
   End If
   If cFrz1.ritardo >= cFrz2.ritardo Then
      If bDettagli Then cFrz1.ScriviNumeri
      Call cFrz1.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr ,bDettagli)
      If bDettagli Then cFrz2.ScriviNumeri
      Call cFrz2.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr ,bDettagli)
   Else
      If bDettagli Then cFrz2.ScriviNumeri
      Call cFrz2.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr ,bDettagli)
      If bDettagli Then cFrz1.ScriviNumeri
      Call cFrz1.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr ,bDettagli)
   End If
   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,"2;3;5;11")
   Call AddColonna(coll,"3;4;6;12")
   Call AddColonna(coll,"4;5;7;13")
   Call AddColonna(coll,"1;5;6;8")
   Call AddColonna(coll,"2;6;7;9")
   Call AddColonna(coll,"3;7;8;10")
   Call AddColonna(coll,"4;8;9;11")
   Call AddColonna(coll,"5;9;10;12")
   Call AddColonna(coll,"6;10;11;13")
   Call AddColonna(coll,"1;7;11;12")
   Call AddColonna(coll,"2;8;12;13")
   Call AddColonna(coll,"1;3;9;13")
   Call AddColonna(coll,"1;2;4;10")
End Sub
Sub AddColonna(coll,sNumeri)
   Dim clsCol
   Set clsCol = New clsColonna
   clsCol.SetNumeri(sNumeri)
   coll.Add clsCol
End Sub
Sub GiocaLunghetta(CollSistema,aLunghetta,nColpiUsati,RuotaDiGioco,nSorte,aPosteProg,idEstr,nColpiAttesa)
   Dim idG,k
   Dim cCol
   Dim aN
   ReDim aP(10)
   ReDim aRt(1)
   aRt(1) = RuotaDiGioco
   For k = 1 To UBound(aPosteProg)
      idG = 0
      If k <= nColpiUsati - nColpiAttesa Then
         Scrivi "Colpo : " & k,True,,,,4
         aP(nSorte) = aPosteProg(k)
         For Each cCol In CollSistema
            idG = idG + 1
            Call cCol.ConvertiColonna(aLunghetta,aN)
            Call ImpostaGiocata(idG,aN,aRt,aP,1,nSorte)
         Next
         Gioca(idEstr - 1) + k + nColpiAttesa
      End If
   Next
End Sub
 

genios

Advanced Member >PLATINUM<
Precedendo gli sfotto di Alien e i legend . :) :) :) :) :) :) :) :) :)

Ti dico che è perfetto grazie . Dovresti pero prendere 7 numeri di una decina e 7 dell' altra decina poiché il sistema da applicare gioca 14 numeri. Ora non ci resta che applicare il seguente sistema


combinazione #1 :​
01 - 02 - 03 - 04 - 05 - 06​
combinazione #2 :​
09 - 10 - 11 - 12 - 13 - 14​
combinazione #3 :​
05 - 06 - 07 - 08 - 13 - 14​
combinazione #4 :​
01 - 02 - 07 - 08 - 09 - 10​
combinazione #5 :​
03 - 04 - 07 - 08 - 11 - 12​

Come hai gia fatto con le quartine al lotto. E giocare solo per 6 estrazioni .

Grazie prima o poi guadagniamo.

Ciao Eugenio
 

adispo2000

Super Member >PLATINUM<
Scusa Giggio, potresti realizzare questo script...quello che volevo analizzare e con quale frequenza e quali colonne in modo lessicografico escono con un determinato punteggio, per esempio se io vado ad analizzare l'archivio con l'ultima estrazione uscita del superenalotto cercando le colonne che hanno realizzato zero punti, lo script dovra indicare tutte le colonne interessate con zero punti...tipo inserisco estrazione es:1-2-3-4-5-6 chiedo tutte le colonne con zero punti..e ci ristituisce colonna 12..36..128..250..ecc....
Pero' noi dovremmo fare un analisi, quindi secondo me lo script dovrebbe essere strutturato in questo modo....richiamare il file interessato in formato txt (lunghezza sei se parliamo di super,) oppure l'archivio stesso di spaziometria , stabilire quante estrazioni analizzare tipo dalla prima alla xxx, poi stabilire se' analizzare tutto il file oppure a cicli di xxx..stabilire il punteggio da cercare partendo da zero punti..infine lo script ci da il numero delle colonne con piu' uscite, la frequenza e quali colonne escono piu' frequente insieme...
Non so' se sono stato chiaro
 

adispo2000

Super Member >PLATINUM<
se tu vedi l'immagine postata vedi che facendo lo spoglio e ricercando lo zero..abbiamo la colonna 1 ok, la colonna 2ok, colonna 3 no perche ha realizzato 1 punto, colonna 4 si, ecc..
 

Allegati

  • Cattura.PNG
    Cattura.PNG
    24,4 KB · Visite: 24

Giggio

Super Member >PLATINUM<
Scusa Giggio, potresti realizzare questo script...quello che volevo analizzare e con quale frequenza e quali colonne in modo lessicografico escono con un determinato punteggio, per esempio se io vado ad analizzare l'archivio con l'ultima estrazione uscita del superenalotto cercando le colonne che hanno realizzato zero punti, lo script dovra indicare tutte le colonne interessate con zero punti...tipo inserisco estrazione es:1-2-3-4-5-6 chiedo tutte le colonne con zero punti..e ci ristituisce colonna 12..36..128..250..ecc....
Pero' noi dovremmo fare un analisi, quindi secondo me lo script dovrebbe essere strutturato in questo modo....richiamare il file interessato in formato txt (lunghezza sei se parliamo di super,) oppure l'archivio stesso di spaziometria , stabilire quante estrazioni analizzare tipo dalla prima alla xxx, poi stabilire se' analizzare tutto il file oppure a cicli di xxx..stabilire il punteggio da cercare partendo da zero punti..infine lo script ci da il numero delle colonne con piu' uscite, la frequenza e quali colonne escono piu' frequente insieme...
Non so' se sono stato chiaro
l'unica cosa chiara è che sei venuto a confondere i messaggi di questo thread
 

Zac

Advanced Premium Member
purtroppo lo script che vado a postare dimostra ancora una volta che al lotto se ci giochi perdi , poi magari mi dimostrerete che mi sbaglio ..
Ho previsto di adottare una progressione di 15 colpi giocando il famoso sistema da 13 quartine per ambo
La progressione di 15 colpi si puo cambiare anche perche con questa di esempio ci vogliono 20.000 euro per arrivare al 15esimo colpo e vincere 5 euro ...

Codice:
Option Explicit
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(Ruota,idEstr,nSorte)
      ReDim aR(1)
      aR(1) = Ruota
      mRitardo = RitardoCombinazioneTurbo(aR,aNum,nSorte,idEstr)
   End Sub
   Sub PrendiNumeriPiuRecenti(nQuantita,aRetNum,idPrimoElem,idEstr,Ruota,bDettagli)
      Dim k
      ReDim aE(10,2)
      For k = 1 To 10
         aE(k,1) = aNum(k)
         aE(k,2) = RitardoEstrattoTurbo(aNum(k),idEstr,Ruota)
      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
   Dim CollSistema
   Dim idEstr,RitMin,RitMax
   Dim cFrz1,cFrz2
   Dim nSorte
   Dim RuotaDiGioco
   Dim aRegistro
   Dim nTotCasi,nTotVincenti
   Dim nUltima
   Dim bDettagli
   Dim nColpiUsati
   Dim aPosteProg
   Dim aLunghetta
   Dim bGioca
   ReDim aQPerEsito(5)
  
  
   If MsgBox("MOSTRARE I DETTAGLI DELLE LUNGHETTE GIOCATE CON LE FORMAZONI SCELTE E GLI ESITI ?",vbQuestion + vbYesNo) = vbYes Then
      bDettagli = True
   End If
   If MsgBox("SIMULARE LE GIOCATE CON LA PROGRESSIONE ?",vbQuestion + vbYesNo) = vbYes Then
      bGioca = True
   End If
  
  
   nSorte = 2
   RitMin = 27
   RitMax = 36
  
   ReDim aProgressioni(15)
   ' la progressione prevede di vincere minimo 10 euro entro 15 colpi giocati per ambo
  
    aProgressioni(1) = 3.00
   aProgressioni(2) = 5.00
   aProgressioni(3) = 7.50
   aProgressioni(4) = 12.00
   aProgressioni(5) = 18.50
   aProgressioni(6) = 28.50
   aProgressioni(7) = 44.00
   aProgressioni(8) = 68.50
   aProgressioni(9) = 106.00
   aProgressioni(10) = 164.50
   aProgressioni(11) = 255.00
   aProgressioni(12) = 395.50
   aProgressioni(13) = 613.50
   aProgressioni(14) = 951.00
   aProgressioni(15) = 1475.00


  
  
  
   Call AlimentaCollRuote(CollRuote)
   Call AlimentaRegistro(aRegistro)
   Call AlimentaColonneSistema(CollSistema)
   For idEstr = EstrazioneIni To EstrazioneFin
      Call CalcolaRitardi(CollRuote,idEstr,nSorte)
      If TrovaFormazioniDaGiocare(CollRuote,cFrz1,cFrz2,RitMin,RitMax,RuotaDiGioco) Then
         Call VerificaLunghetta(cFrz1,cFrz2,RuotaDiGioco,idEstr,RuotaDiGioco,nSorte,aRegistro,nTotCasi,nTotVincenti,aQPerEsito,bDettagli,nColpiUsati,aLunghetta)
         If bGioca Then Call GiocaLunghetta(CollSistema,aLunghetta,nColpiUsati,RuotaDiGioco,nSorte,aProgressioni,idEstr)
      End If
      Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,idEstr)
      nUltima = idEstr
      If ScriptInterrotto Then Exit For
   Next
   Call ScriviRegistro(aQPerEsito,aRegistro,nTotCasi,nTotVincenti,EstrazioneIni,nUltima)
   ScriviResoconto
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 r
   Dim cFrz,cRuota
   Set CollRuote = GetNewCollection
   For r = 1 To 12
      If r <> 11 Then
         Set cRuota = New clsRuota
         cRuota.Ruota = r
         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 If
   Next
End Sub
Sub CalcolaRitardi(collRuote,idEstr,nSorte)
   Dim cRuota,cFrz
   For Each cRuota In collRuote
      For Each cFrz In cRuota.CollFormazioni
         Call cFrz.CalcRitardi(cRuota.Ruota,idEstr,nSorte)
      Next
   Next
End Sub
Function TrovaFormazioniDaGiocare(CollRuote,cFrz1,cFrz2,RitMin,RitMax,RuotaDiGioco)
   Dim cRuota,cFrz
   Dim nTrovate
   For Each cRuota In CollRuote
      nTrovate = 0
      For Each cFrz In cRuota.CollFormazioni
         If cFrz.Ritardo >= RitMin And cFrz.Ritardo <= RitMax Then
            nTrovate = nTrovate + 1
            Select Case nTrovate
            Case 1
               Set cFrz1 = cFrz
            Case 2
               Set cFrz2 = cFrz
            Case Else
               Exit For
            End Select
         End If
      Next
      If nTrovate = 2 Then
         RuotaDiGioco = cRuota.ruota
         TrovaFormazioniDaGiocare = True
         Exit Function
      End If
   Next
   TrovaFormazioniDaGiocare = False
End Function
Sub VerificaLunghetta(cFrz1,cFrz2,RuotaDiGioco,idEstr,Ruota,nSorte,aRegistro,nTotCasi,nTotVincenti,aQPerEsito,bDettagli,nRetColpiDiGioco,aNumLunghetta)
   Dim sEsito,nRetColpi,sRetEstratti
   ReDim aNumLunghetta(13)
   nTotCasi = nTotCasi + 1
   If bDettagli Then
      Call Scrivi("Numeri ricavati all'estrazione " & GetInfoEstrazione(idEstr) & " per " & NomeRuota (RuotaDiGioco) ,True,,vbYellow,,4)
      Scrivi
   End If
   If cFrz1.ritardo >= cFrz2.ritardo Then
      If bDettagli Then cFrz1.ScriviNumeri
      Call cFrz1.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr,Ruota,bDettagli)
      If bDettagli Then cFrz2.ScriviNumeri
      Call cFrz2.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr,Ruota,bDettagli)
   Else
      If bDettagli Then cFrz2.ScriviNumeri
      Call cFrz2.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr,Ruota,bDettagli)
      If bDettagli Then cFrz1.ScriviNumeri
      Call cFrz1.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr,Ruota,bDettagli)
   End If
   If bDettagli Then Call Scrivi("Lunghetta : " & StringaNumeri(aNumLunghetta))
   ReDim aRuoteG(1)
   aRuoteG(1) = Ruota
   If VerificaEsito(aNumLunghetta,aRuoteG,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
   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 : " & GetInfoEstrazione(Inizio)
   Scrivi "Estrazione fine   : " & GetInfoEstrazione(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,"2;3;5;11")
   Call AddColonna(coll,"3;4;6;12")
   Call AddColonna(coll,"4;5;7;13")
   Call AddColonna(coll,"1;5;6;8")
   Call AddColonna(coll,"2;6;7;9")
   Call AddColonna(coll,"3;7;8;10")
   Call AddColonna(coll,"4;8;9;11")
   Call AddColonna(coll,"5;9;10;12")
   Call AddColonna(coll,"6;10;11;13")
   Call AddColonna(coll,"1;7;11;12")
   Call AddColonna(coll,"2;8;12;13")
   Call AddColonna(coll,"1;3;9;13")
   Call AddColonna(coll,"1;2;4;10")
End Sub
Sub AddColonna(coll,sNumeri)
   Dim clsCol
   Set clsCol = New clsColonna
   clsCol.SetNumeri(sNumeri)
   coll.Add clsCol
End Sub
Sub GiocaLunghetta(CollSistema,aLunghetta,nColpiUsati,RuotaDiGioco,nSorte,aPosteProg,idEstr)
   Dim idG,k
   Dim cCol
   Dim aN
   ReDim aP(10)
   ReDim aRt(1)
   aRt(1) = RuotaDiGioco
   For k = 1 To UBound(aPosteProg)
      idG = 0
      If k <= nColpiUsati Then
         Scrivi "Colpo : " & k,True,,,,4
         aP(nSorte) = aPosteProg(k)
         For Each cCol In CollSistema
            idG = idG + 1
            Call cCol.ConvertiColonna(aLunghetta,aN)
            Call ImpostaGiocata(idG,aN,aRt,aP,1)
         Next
         Gioca(idEstr - 1) + k
      End If
   Next
End Sub
Ciao Giggio
Qualsiasi progressione utilizzi dovrai sostenere per tutti i 15 colpi un grosso esborso di capitale a fronte di poco guadagno.
Ad esempio se vuoi un guadagno minimo di 50 euro (ho utilizzato spaziometria per il calcolo) al 18 colpo avrai speso circa 17.740 euro e in caso di vincita ne incasseresti 1.230 circa. Non sarebbe male come investimento ma devi tener conto che basta un solo esito negativo per non riuscire più a recuperare.
Buon pomeriggio
 

Giggio

Super Member >PLATINUM<
Genios dalle prove il tuo sistema non mi convince forse m isbaglio ma ce ne ho msso un altro , garanzia ambo.
Comunque per mettere quell oche vuoi tu basta modificare questa sub

Codice:
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

Codice:
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
 

arcor

Advanced Member
Buonasera oggi ho dedicato qualche ora nel ricercare una progressione ottimale che coniughi spesa limitata resa discreta e pochi colpi e purtroppo devo dire che 13 numeri sono troppi per poter avere un mix di gioco giusto.le strade sono solo due o si diminuiscono i numeri oppure i colpi,entrambe le strade però diminuiscono di molto l'esito del nostro pronostico.o anche provato a diversificare le giocate con ambi terzine quartine e cinquine ma la spesa totale è ancora troppo alta.questa è una progressione nei 9 colpi.
 

Allegati

  • test.png
    test.png
    9,3 KB · Visite: 18
  • test2.png
    test2.png
    71,7 KB · Visite: 18

Giggio

Super Member >PLATINUM<
Grazie Arcor , per modificare la progression enello script che i riferisce al lotto bisogna agire qui m ,cambiando dimensione all'array e i relativi valori di spesa.



Codice:
ReDim aProgressioni(15)
   ' la progressione prevede di vincere minimo 10 euro entro 15 colpi giocati per ambo
   
    aProgressioni(1) = 3.00
   aProgressioni(2) = 5.00
   aProgressioni(3) = 7.50
   aProgressioni(4) = 12.00
   aProgressioni(5) = 18.50
   aProgressioni(6) = 28.50
   aProgressioni(7) = 44.00
   aProgressioni(8) = 68.50
   aProgressioni(9) = 106.00
   aProgressioni(10) = 164.50
   aProgressioni(11) = 255.00
   aProgressioni(12) = 395.50
   aProgressioni(13) = 613.50
   aProgressioni(14) = 951.00
   aProgressioni(15) = 1475.00
 

Alien.

Advanced Premium Member
ok ok .. com si dice leviamoci la sete col prosciutto , per la serie basta che funziona ecco lo script modificato per il superenalotto.
Piccola nota il range dl ritardo va abbassato io ho messo 10/18 senno non trova proprio niente da giocare

Codice:
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)
           
         Next
      Else
         Scrivi    "NESSUNA PREVISIONE"
        
      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
   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(13)
   nTotCasi = nTotCasi + 1
   If bDettagli Then
      Call Scrivi("Numeri ricavati all'estrazione " & GetInfoEstrazioneSE(idEstr))
     
      Scrivi
   End If
   If cFrz1.ritardo >= cFrz2.ritardo Then
      If bDettagli Then cFrz1.ScriviNumeri
      Call cFrz1.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr ,bDettagli)
      If bDettagli Then cFrz2.ScriviNumeri
      Call cFrz2.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr ,bDettagli)
   Else
      If bDettagli Then cFrz2.ScriviNumeri
      Call cFrz2.PrendiNumeriPiuRecenti(7,aNumLunghetta,1,idEstr ,bDettagli)
      If bDettagli Then cFrz1.ScriviNumeri
      Call cFrz1.PrendiNumeriPiuRecenti(6,aNumLunghetta,8,idEstr ,bDettagli)
   End If
   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,"2;3;5;11")
   Call AddColonna(coll,"3;4;6;12")
   Call AddColonna(coll,"4;5;7;13")
   Call AddColonna(coll,"1;5;6;8")
   Call AddColonna(coll,"2;6;7;9")
   Call AddColonna(coll,"3;7;8;10")
   Call AddColonna(coll,"4;8;9;11")
   Call AddColonna(coll,"5;9;10;12")
   Call AddColonna(coll,"6;10;11;13")
   Call AddColonna(coll,"1;7;11;12")
   Call AddColonna(coll,"2;8;12;13")
   Call AddColonna(coll,"1;3;9;13")
   Call AddColonna(coll,"1;2;4;10")
End Sub
Sub AddColonna(coll,sNumeri)
   Dim clsCol
   Set clsCol = New clsColonna
   clsCol.SetNumeri(sNumeri)
   coll.Add clsCol
End Sub
Sub GiocaLunghetta(CollSistema,aLunghetta,nColpiUsati,RuotaDiGioco,nSorte,aPosteProg,idEstr,nColpiAttesa)
   Dim idG,k
   Dim cCol
   Dim aN
   ReDim aP(10)
   ReDim aRt(1)
   aRt(1) = RuotaDiGioco
   For k = 1 To UBound(aPosteProg)
      idG = 0
      If k <= nColpiUsati - nColpiAttesa Then
         Scrivi "Colpo : " & k,True,,,,4
         aP(nSorte) = aPosteProg(k)
         For Each cCol In CollSistema
            idG = idG + 1
            Call cCol.ConvertiColonna(aLunghetta,aN)
            Call ImpostaGiocata(idG,aN,aRt,aP,1,nSorte)
         Next
         Gioca(idEstr - 1) + k + nColpiAttesa
      End If
   Next
End Sub
Scusami mi son bevuto 2 bottiglie di Montalcino ma ho ancora sete,mi spieghi cosa dovrei giocarmi al superenalotto.........una decina ?Grazie.
 

genios

Advanced Member >PLATINUM<
Non so per quale motivo lo script non ha messo in gioco questa previsione :
NESSUNA PREVISIONE

Estrazione : [03194] [125] 28.11.2020
1.2.3.4.5.6.7.8.9.10 Rit : 1
11.12.13.14.15.16.17.18.19.20 Rit : 2
21.22.23.24.25.26.27.28.29.30 Rit : 17
31.32.33.34.35.36.37.38.39.40 Rit : 7
41.42.43.44.45.46.47.48.49.50 Rit : 4
51.52.53.54.55.56.57.58.59.60 Rit : 7
61.62.63.64.65.66.67.68.69.70 Rit : 6
71.72.73.74.75.76.77.78.79.80 Rit : 23
81.82.83.84.85.86.87.88.89.90 Rit : 0

Andavano giocati i 14 numeri seguenti :

76 78 77 79 73 75 74
29 23 24 30 22 26 28

combinazione #1 :​
76 - 29 - 78 - 23 - 77 - 24
combinazione #2 :​
73 - 22 - 75 - 26 - 74 - 28​
combinazione #3 :​
77 - 24 - 79 - 30 - 74 - 28​
combinazione #4 :​
76 - 29 - 79 - 30 - 73 - 22​
combinazione #5 :​
78 - 23 - 79 - 30 - 75 - 26​
combinazione #6 :​
76 - 29 - 78 - 79 - 75 - 74​
combinazione #7 :​
76 - 29 - 78 - 30 - 26 - 28​
combinazione #8 :​
77 - 24 - 30 - 22 - 75 - 26​
combinazione #9 :​
76 - 29 - 23 - 73 - 75 - 26​
combinazione #10 :​
76 - 29 - 23 - 22 - 74 - 28​
combinazione #11 :​
23 - 24 - 30 - 73 - 26 - 28​
combinazione #12 :​
23 - 24 - 79 - 22 - 26 - 74​
combinazione #13 :​
23 - 77 - 30 - 73 - 75 - 74​
combinazione #14 :​
23 - 77 - 79 - 22 - 75 - 28​
combinazione #15 :​
78 - 24 - 30 - 73 - 22 - 74​
combinazione #16 :​
78 - 24 - 79 - 73 - 75 - 28​
combinazione #17 :​
78 - 77 - 79 - 73 - 26 - 74​
combinazione #18 :​
76 - 78 - 77 - 73 - 22 - 75​
combinazione #19 :​
29 - 78 - 24 - 73 - 22 - 28​
 

Alien.

Advanced Premium Member
Ciao.

Ma no è raro che escano 6 numeri di sole due decine al superenalotto in genere 1 o 2 o nessuno quindi ...........

servono numeri spia è........... :unsure: :D :D
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 26 marzo 2024
    Bari
    30
    51
    17
    01
    53
    Cagliari
    13
    70
    25
    68
    47
    Firenze
    28
    30
    54
    70
    88
    Genova
    67
    87
    22
    03
    62
    Milano
    22
    34
    13
    47
    24
    Napoli
    20
    72
    59
    01
    52
    Palermo
    05
    72
    65
    52
    32
    Roma
    28
    43
    75
    54
    87
    Torino
    16
    08
    17
    24
    38
    Venezia
    67
    28
    55
    60
    29
    Nazionale
    15
    69
    22
    63
    39
    Estrazione Simbolotto
    Firenze
    44
    09
    31
    22
    16
Alto