Novità

Per GioRyuKen72

Grazie Salvo, come sempre risolvi sempre tutto e massimo stima per i tuoi lavori.

No, non è un tuo script, ma tutti quelli che faccio io hanno il tuo scheletro e mi piace scriverlo all'interno di essi ;) .
Grazie anche a te i legend, ma per ora non ho capito bene come lavorare sugli array :(.

Ora vedrò se i 2 nuovi casi aggiunti danno gli stessi risultati delle sopracitate estrazioni 7305 e 7965.

Ciao a tutti.
Grazie.
 
Ciao a tutti :)
ciao Joe , mi fa piacere vedere che continui ad insegnare :)
ho proposto questa soluzione perchè la ritengo la piu semplice, tutti quei cicli for possono portare errori
e la raccolta dati si ottiene in realta usando lo stesso principio .
per essere piu chiaro per chi vuole imparare , non per te o salvo , ho inserito la soluzione in una sub
è piu semplice è un po piu veloce almeno sul mio pc
allora test 1
Codice: 
Option Explicit
' Test
Sub Main
   Dim R1,R2,IdEstr
   Dim Ini,Fin,sEstr
   Dim Punti:Punti=4
   Dim aRic:aRic=Array(0,"-","Am","Tr","Qt","Cq") 
   Dim sRip:sRip=aRic(Punti)
   Dim Linea:Linea=String(18,"-")
   If Punti<2 Then Exit Sub
   Ini = 3950
   Fin = EstrazioneFin
   Call ResetTimer
   For IdEstr = Ini To Fin
      For R1 = 1 To 10
         ReDim aR1(0)
         Call GetArrayNumeriRuota(IdEstr,R1,aR1)
         For R2 = R1 + 1 To 12
            If R2 = 11 Then R2 = 12
            ReDim aR2(0)
            Call GetArrayNumeriRuota(IdEstr,R2,aR2)
            If PuntiSuArray(aR1,aR2) >= Punti Then
               Scrivi IdEstr
               Scrivi SiglaRuota(R1) & "  " & StringaEstratti(IdEstr,R1)
               Scrivi SiglaRuota(R2) & "  " & StringaEstratti(IdEstr,R2)
               Scrivi sRip& "  ",1,0
               Call GetStringaRipetuti(aR1,aR2,sEstr)
               Scrivi sEstr
               Scrivi Linea
            End If
         Next ' r2
      Next ' r1
      Call AvanzamentoElab(Ini,Fin,IdEstr)
   Next ' idestr
   Scrivi TempoTrascorso
End Sub
' questa sub raccoglie i numeri in comune
Sub GetStringaRipetuti(aR1,aR2,sEstr)
   Dim E,aE(1)
   sEstr=""
   For E = 1 To 5
      aE(1) = aR1(E)
      If PuntiSuArray(aR2,aE) Then sEstr=sEstr& Format2(aE(1)) & "."
   Next
  sEstr=Left(sEstr,Len(sEstr)-1)
End Sub
ho visto che hai messo punti=5 ,utilizzando spaziometria 1.6.31 , bisogna inserire i punti che si vogliono ottenere
non so come è stata modificata la funzione nelle versioni successive
ciao a tutti :)
fa piacere vedere che ci sia ancora qualcuno che si diverte ad imparare ;)
 
Questa è la soluzione/correzione che avevo applicato allo script proposto.

... è da completare.

Codice: 
Sub Main
 ColoreTesto 0
 Scrivi " METODO DOPPIA QUATERNA  -------- LISTATO BY SALVO50 modificato da GIORYUKEN72",,1,3,,4
 Scrivi
 ColoreTesto 0
 Dim Fin,Ini,Es,R1,R2,Casi,P1,P2,P3,P4
 Dim N(4),cinquina1(5),Terzina1(3),Terzina2(3)
 Dim ruota(2),posteC(4),posteT(3)
 posteC(2) = 1.8 'euro sulla sorte Ambo in Cinquina
 posteC(3) = 0.5 'euro sulla sorte Terno in Cinquina
 posteC(4) = 0.2 'euro sulla sorte Quaterna in Cinquina
 posteT(2) = 1 'euro sulla sorte Ambo in Terzina
 posteT(3) = 0.5 'euro sulla sorte Terno in Terzina
 Fin = EstrazioneFin
 Ini = InputBox("Da quale estrazione vuoi inziare la ricerca?","INSERIRE IL NUMERO DELL'ESTRAZIONE",3950)
 'Call ScegliRange(EstrazioneIni,Fin,Ini,EstrazioneFin)
 For Es = Ini To Fin
  AvanzamentoElab Ini,Fin,Es
  For R1 = 1 To 10
   For P1 = 1 To 2
    N(1) = Estratto(Es,R1,P1)
    For P2 = P1 + 1 To 3
     N(2) = Estratto(Es,R1,P2)
     For P3 = P2 + 1 To 4
      N(3) = Estratto(Es,R1,P3)
      For P4 = P3 + 1 To 5
       N(4) = Estratto(Es,R1,P4)
       For R2 = R1 + 1 To 12
        If R2 = 11 Then R2 = 12
        If Posizione(Es,R2,N(1)) > 0 Then
         If Posizione(Es,R2,N(2)) > 0 Then
          If Posizione(Es,R2,N(3)) > 0 Then
           If Posizione(Es,R2,N(4)) > 0 Then
            Casi = Casi + 1
            ruota(1) = R1
            ruota(2) = R2
            Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Casi,"0000"),1,,,1
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1),1
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R2) & " " & StringaEstratti(Es,R2),1
            Scrivi Space(60) & StringaNumeri(N," ",True),1,,,2
            'Gioca Es,,,1
           End If
          End If
         End If
        End If
       Next
      Next
     Next
    Next
   Next
  Next
 Next
 ColoreTesto 0
 Scrivi String(106,"•")
 TestoInBandaPassante " ***** LISTATO BY SALVO50 modificato da GIORYUKEN72 ***** ",1,3,0
 ScriviResoconto
End Sub

:)
 
Ultima modifica:
Ciao a Tutti.

Sarà una soluzione eccellente, ma io preferisco quella del post 17, perchè quella per un apprendista come me è più intuitiva, questa del post 23 non la capisco, se inserisco inizio estrazione, un numero minore di 3950, vengono fuori anche queste righe

Codice: 
METODO DOPPIA QUATERNA  -------- LISTATO BY SALVO50 modificato da GIORYUKEN72

******************************************************************************** Estrazione 3000 caso 0001
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  GE 00

******************************************************************************** Estrazione 3000 caso 0002
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  NZ 00

******************************************************************************** Estrazione 3000 caso 0003
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  GE 00

******************************************************************************** Estrazione 3000 caso 0004
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  NZ 00

******************************************************************************** Estrazione 3000 caso 0005
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  GE 00

******************************************************************************** Estrazione 3000 caso 0006
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  NZ 00

******************************************************************************** Estrazione 3000 caso 0007
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  GE 00

******************************************************************************** Estrazione 3000 caso 0008
 Estrazione n.3000 del 30.06.1928  CA 00
 Estrazione n.3000 del 30.06.1928  NZ 00

e qui il cervello mi va in tilt, se c'è il filtro che il numero deve essere maggiore di zero, perchè appaiono queste righe?

Non datemi la risposta ci voglio arrivare da solo

Grazie di tutto
 
Ultima modifica:
Salvo ...

... se prendi il browser delle estrazioni e guardi cosa c'è nella 3000 e confronti,

le ruote che ha elencato il tuo script con le ruote-vuote di quel' IdEstrazione vedi che ...

... è semplice far quadrare i conti che non ti tornano.

xSalvo.jpg

Sono le ruote di Ca_Ge_Nz_ nelle loro combinazioni.

Perchè uno "Zero" ... confrontato con 4 o 5 Zeri da .... 4 o 5 punti di eguaglianza.

Il problema è nello zeresimo numero che, con con indice zero, NON è escluso.

Infatti ... evidenziava Ilegend che il controllo di una QUATERNA

l'ho fatto su "5 punti" e non su 4. 4 come dovrebbero essere i 4 numeri che la compongono.

Anche zero però ... è un numero contenuto nell'Array ottenuto con Get.

Se lo confronti con 5 zeri di una estrazione vuota è 5 volte uguale a Zero. Cioè da 5 punti.

Nel mio script, aggiungi semplicemente If SommaEstratti (Es,R) > 0 Then

come prima istruzione dentro il ciclo For-Next controllato da "R"

così esso può controllare tutto l'archivio dalla prima all'ultima estrazione

escludendo automaticamente tutte le ruote-vuote.

Codice: 
Option Explicit
Sub Main
'Ricerca Quaterne Ripetute By Joe V.2.1 del 14/09/2019
Dim Ini,Fin,Es
Dim R,S,A,B,P,K,Q
Ini = 1 : Fin = EstrazioneFin
For Es = Ini To Fin : AvanzamentoElab Ini,Fin,Es
  For R = 1 To 10
   If SommaEstratti(Es,R) > 0 Then
    Call GetArrayNumeriRuota(Es,R,A)
    For S = R + 1 To 12 : If S = 11 Then S = 12
     Call GetArrayNumeriRuota(Es,S,B)
     If PuntiSuArray(A,B) = 5 Then
      K = K + 1
      Scrivi DataEstrazione(Es) & " ",True
      Scrivi SiglaRuota(R) & " " & StringaNumeri(A,".",True)
      Scrivi SiglaRuota(S) & " " & StringaNumeri(B,".",True)
      Scrivi "QT ",True,False
      For P = 1 To 5
       For Q = 1 To 5
        If A(P) = B(Q) Then Scrivi Format2(A(P)) & " ",True,False
       Next
      Next
      Scrivi
      Scrivi String(18,"-") & FormatSpace(K,4,True)
     End If
    Next
   End If
  Next
Next
Scrivi TempoTrascorso
End Sub

:) Buon WeekEnd a tutte/i.
 
Ultima modifica:
Ciao a tutti,
come suggerito da @salvo50, porto sù questo post per una mia richiesta.

E' possibile avere uno script che restituisca le sortite negli ultimi anni [in modo decrescente da sx verso dx], di un ambo a tutte inserito nell'inputbox?

esempio:
ambo
23​
22​
21​
20​
19​
18​
17​
16​
56-70
9​
6​
5​
2​
7​
​

Grazie
Saluti, Gio.
 
Ciao a Tutti

Ho faticato non poco per capire cosa avevo fatto nel 2019
Riguardo a l'ultima richiesta, non ho idea di come fare
mi dispiace, magari è semplicissimo, ma a volte annego
in un bicchiere d'acqua.
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 07 gennaio 2025
    Bari
    29
    37
    09
    53
    08
    Cagliari
    33
    56
    08
    61
    20
    Firenze
    55
    33
    09
    60
    28
    Genova
    56
    09
    78
    59
    04
    Milano
    73
    51
    34
    06
    70
    Napoli
    49
    30
    64
    80
    05
    Palermo
    89
    08
    74
    48
    30
    Roma
    46
    20
    13
    87
    05
    Torino
    05
    85
    90
    28
    16
    Venezia
    51
    42
    17
    05
    09
    Nazionale
    88
    90
    72
    25
    41
    Estrazione Simbolotto
    Bari
    06
    22
    29
    11
    31
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto