Il mio primo metodo : lo chiamerò "Lascio o raddoppio"

franca46 · Ieri alle 16:50

ciao a tutti, @marina2009, @bubù nell'attesa di uno script fatto bene dagli scripter Senior vi posto il mio che è aperto a tante possibilità.

Dopo il lancio dello script potrete scegliere tante cose:
-su quante estrazioni fare la ricerca
-su quante estrazioni di differenza
-quale posizione fare la ricerca
-scelta della ruota di ricerca
-scelta delle ruote di gioco

Codice:

Sub Main()
   'https://forum.lottoced.com/threads/il-mio-primo-metodo-lo-chiamer%C3%B2-lascio-o-raddoppio.2223308/#post-2744053
   Scrivi " TEST: LASCIO O RADDOPPIO di MARINA2009 [giugno 2025] ---- script di GioRyuKen72             ",1,,2,6,5,,1
   Dim Ru(1),Nn(2),E1,E2,P5,P6
   Dim Terno1(4),PostaT(3),Cinquina1(5),PostaC(5),Ambata(1),Ambo1(2),PostaA(2)
   Dim Num(4)
   ex = CInt(InputBox("Quante estrazioni controllo?","Estrazioni",54))
   ini = EstrazioneFin - ex
   fin = EstrazioneFin
   estra = CInt(InputBox("Quante estrazioni di differenza ricerco?","Estrazioni indietro",1))
   p = CInt(InputBox("Posizione Estratto 1, 2, 3, 4 o 5 ?","In quale Posizione estrattiva?",5))
   r =InputBox("1=BARI, 2=CAGLIARI, 3=FIRENZE, 4=GENOVA, 5=MILANO, 6=NAPOLI, 7=PALERMO, 8=ROMA, 9=TORINO, 10=VENEZIA, 12=NAZIONALE","Scelta Ruota di Ricerca",7)
   ReDim Rg(0)
rr = ScegliRuote(Rg) 'InputBox("Scelta Ruota di Gioco",,1)
   For es = ini To fin
   Ru(1)= r
    Messaggio es
      rr = Rg
       Nn(1) = Estratto(es -(estra),r,p) : Nn(2) = Estratto(es,r,p)
      Num(1) = Fuori90(Nn(1) + Nn(2))
      Num(2) = Fuori90(Num(1) + 3)
      Num(3) = Nn(1)
      Num(4) = Nn(2)
      Ambata(1) = Fuori90(Num(1) + Num(2))
      'rt(1) = CA_
      'rt(2) = FI_
      'rt(3) = TT_
      PostaA(2) = 1
      PostaT(2) = 1
      PostaT(3) = 0.5
      PostaC(2) = 1.6
      PostaC(3) = 0.9
      PostaC(4) = 0.4
      PostaC(5) = 0.1
      k = 15
      Ambo1(1) = Ambata(1)
      Ambo1(2) = Num(2)
      ImpostaGiocata 2,Ambo1,rr,PostaA,k,2 '2 significa che ferma le giocate solo dopo il primo ambo
      Terno1(1) = Ambata(1)
      Terno1(2) = Num(1)
      Terno1(3) = Num(2)
      ImpostaGiocata 3,Terno1,rr,PostaT,k,3 '3 significa che ferma le giocate solo dopo il primo terno (gli ambi vanno fino alla fine)
      Cinquina1(1) = Ambata(1)
      Cinquina1(2) = Num(1)
      Cinquina1(3) = Num(2)
      Cinquina1(4) = Num(3)
      Cinquina1(5) = Num(4)
      ImpostaGiocata 4,Cinquina1,rr,PostaC,k,4 '4 significa che ferma le giocate solo dopo il primo quaterna (i terni vanno fino alla fine)
      casi = casi + 1
      Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
      Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
      ColoreTesto 0
      Scrivi("Estrazione n." & Format2(Es -(estra)) & " del " & DataEstrazione(Es -(estra))),1,0
      Scrivi "  " & SiglaRuota(r) & " ",1,0
      For P5 = 1 To 5
         E1 = Estratto(Es -(estra),r,P5)
         If E1 = Nn(1) Or E1 = Nn(2) Then
            ColoreTesto 2
         Else
            ColoreTesto 0
         End If
         Scrivi Format2(E1) & " ",1,0
         ColoreTesto 0
      Next
      Scrivi
      Scrivi("Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
      Scrivi "  " & SiglaRuota(r) & " ",1,0
      For P6 = 1 To 5
         E2 = Estratto(Es,r,P6)
         If E2 = Nn(1) Or E2 = Nn(2) Then
            ColoreTesto 2
         Else
            ColoreTesto 0
         End If
         Scrivi Format2(E2) & " ",1,0
         ColoreTesto 0
      Next
      Scrivi
      Scrivi String(78,"-"),1
      ColoreTesto 1
      ' OrdinaMatrice Nn,1
      Scrivi "Numeri Ricercati:  " & Format2(Nn(1)) & " - " & Format2(Nn(2)),1,0
      Scrivi
      ColoreTesto 0
      Scrivi String(78,"-"),1
      Scrivi
      Gioca es,True,,1
      If ScriptInterrotto Then Exit For
   Next
   Scrivi
   Scrivi "Casi totali (" & casi & ")",1
   ScriviDistribuzioneEsiti(True)
   ScriviDistribuzioneCasiInCorso(True)
   ScriviResoconto
End Sub

Fatemi sapere se ci sono errori..
Saluti, Gio.

ciao gio , il listato funziona , ho aggiunto la giocata su tutte e spuntano alcuni terni
cambiando ruota di ricerca e posizioni , ci sono buoni risultati

franca46 · Oggi alle 09:00

buon giorno e buona domenica a tutti

ho portato il listato che gentilmente ci ha fatto djnomade , sostanzialmente somiglia a quello fatto da GioRyuKen , dove possiamo scegliere l'estrazione , la ruota di ricerca ruota di gioco e posizione

è per L8

Codice:

ColoreTesto 2: Scrivi
Scrivi String(30," ") & "LASCIO O RADDOPPIO BY MARYLU  ",1
Scrivi
Scrivi Date &_
Chr (32) &Chr (108)& Chr (105)& Chr (115)&Chr (116)&Chr (46)& Chr (32) & Chr (98)& Chr (121)& Chr (32) & Chr (68) & Chr (106)& Chr (78) & Chr (111) & Chr ( 109) & Chr (97)& Chr ( 100) & Chr (101),1
Scrivi String (2,Chr(11)): ColoreTesto 1
ColoreTesto 0
ColoreTesto 0: Scrivi
Sub main()
Dim amb(2),ambo1(4),ambo2(5),ambo3(6),ambo4(2),lg(10),nc(4),nr(1)
Dim ruote(11),ruota(11),posta(10),poste1(5),poste2(5),poste(5)

t=0
EST=CInt(InputBox("Quante estrazioni di ricerca ? ",">",100))
im=CInt(InputBox("Pronostico dall'estrazione mensile numero? (      Scrivi 0=ultima estrazione mese                               Scrivi da 1 a 19= indice mensile                               Scrivi 20= ad ogni estrazione      )",">",1))
r=CInt(InputBox("SCEGLI  RUOTA DI RICERCA ",">",7))
p1=CInt(InputBox("SCEGLI  Posizione Estratto ",">",5))
r1=CInt(InputBox("SCEGLI  1° Ruota di gioco ",">",2))
r2=CInt(InputBox("SCEGLI  2° Ruota di gioco ",">",3))
r3=CInt(InputBox("SCEGLI  3° Ruota di gioco ",">",11))
cl=CInt(InputBox("COLPI DI GIOCO (       )",">",13))
posta(1)=1
posta(2)=1
poste(2)=1
poste1(2)=1.2
poste1(3)=1.6
poste1(4)=.20


ini=EstrazioneFin-EST
For es=ini To EstrazioneFin
AvanzamentoElab ini,EstrazioneFin ,es

If eval(im)<20 Or eval(im)=0 Or eval(im)= 20 Then

If (eval(im)=0  And IsUltimaDelMese(es))Or (eval(im)>0 And IndiceMensile(es)=eval(im))Or (eval(im)=20 And es=es) Then


a1=Estratto(es-1,r,p1)'76
a2=Estratto(es,r,p1)'44
a3=Fuori90(a1+a2)'76+44  30
a4=Fuori90(a3+3)'30+3 33
a5=Fuori90(a3+a4)'30+33 63






'*********************************
ruota(1)=r1
ruota(2)=r2
ruota(3)=r3
If r3=11 Then ruota(1)=r1:ruota(2)=r2:ruota(3)=0

ruote(1)=r1
ruote(2)=r2
ruote(3)=r3
If r3=11 Then ruote(1)=1:ruote(2)=2:ruote(3)=3:ruote(4)=4:ruote(5)=5:ruote(6)=6:
If r3=11 Then ruote(7)=7:ruote(8)=8:ruote(9)=9:ruote(10)=10:
t=t+1
Scrivi "------------------------------------------------------------",1

If (eval(im)=0  And IsUltimaDelMese(es)) Then Scrivi "---------------------------Ultima del Mese --- Giocata n° "& Format2(t),1
If (eval(im)>0 And IndiceMensile(es)=eval(im)) Then Scrivi "---------------"&IndiceMensile(es)&"° ESTRAZIONE  del Mese   Giocata n° "& Format2(t),1
If (eval(im)=20 And es=es) Then Scrivi "---------------"&IndiceMensile(es)&"° ESTRAZIONE  del Mese   Giocata n° "& Format2(t),1

Scrivi DataEstrazione(es-1)&" "&(SiglaRuota(r))&"  -> "& StringaEstratti(es-1,r)&"  -> "&a1 ,1
Scrivi DataEstrazione(es)&" "&(SiglaRuota(r))&"  -> "& StringaEstratti(es,r)&"  -> "&a2 ,1

Scrivi


Scrivi
ColoreTesto 0
amb(1) = a4
amb(2) = a5
ImpostaGiocata 1,amb,ruota,posta,cl

ambo3(1) = a4
ambo3(2) = a5
ambo3(3) = a1
ambo3(4) = a2
ambo3(5) = a3
ImpostaGiocata 2,ambo3,ruote,poste1,cl

Gioca es

End If
End If
Next
ScriviResoconto
End Sub
'
Function IsUltimaDelMese (idEstr)

       Dim sData , sDataNew
       Dim idGiornoSettimana
       Dim gMancanti
       Dim nMeseCorr
      
       sData = Replace(DataEstrazione(idEstr) , "." , "/")
       nMeseCorr = Month(sData)
       idGiornoSettimana = WeekDay (sData)
      
       Select Case idGiornoSettimana
      
       Case vbTuesday ' martedi
               gMancanti =2
       Case vbThursday ' giovedi
               gMancanti = 1  '2  provare con 2
       Case vbFriday ' venerdi ' non c'era
               gMancanti = 1 ' non c'era
       Case vbSaturday ' sabato
               gMancanti = 3
       End Select
      
       sDataNew = DateAdd( "d" , gMancanti ,sData)
      
       If Month (sDataNew) <> nMeseCorr Then
               IsUltimaDelMese = True
       Else
               IsUltimaDelMese = False
       End If
      
End Function

scegliete quale vi viene più semplice da usare

a risentirci

Cerca

Cerca

Il mio primo metodo : lo chiamerò "Lascio o raddoppio"

franca46

Advanced Member >PLATINUM PLUS<

franca46

Advanced Member >PLATINUM PLUS<

Ultima estrazione Lotto

Ultimi Messaggi