Novità

Voglio fare un regalo a tutti .

A.....benissimo...allora da domani fai le valigie...........sei licenziato.


stanlio_e_ollio_che_ridono.gif
 
:):):):):):):) 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 .
 
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
 
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
 
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
 
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
adispo2000 ha scritto:
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
Clicca per espandere...
l'unica cosa chiara è che sei venuto a confondere i messaggi di questo thread
 
Giggio ha scritto:
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
Clicca per espandere...
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
 
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
 
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
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
 
Giggio ha scritto:
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
Clicca per espandere...
Scusami mi son bevuto 2 bottiglie di Montalcino ma ho ancora sete,mi spieghi cosa dovrei giocarmi al superenalotto.........una decina ?Grazie.
 
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​
 
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
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 11 gennaio 2025
    Bari
    73
    43
    01
    58
    81
    Cagliari
    69
    60
    18
    02
    10
    Firenze
    25
    32
    18
    55
    54
    Genova
    48
    05
    40
    34
    69
    Milano
    10
    07
    70
    44
    79
    Napoli
    11
    89
    01
    34
    80
    Palermo
    37
    80
    82
    44
    77
    Roma
    78
    04
    38
    39
    56
    Torino
    08
    13
    30
    27
    24
    Venezia
    56
    75
    36
    18
    70
    Nazionale
    63
    83
    19
    31
    80
    Estrazione Simbolotto
    Bari
    35
    34
    12
    23
    20
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto