Per GioRyuKen72

[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.

 

[i legend]

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

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

 

[salvo50]

Ciao a Tutti.

Rinnovo i ringraziamenti, e aggiungo che mi sopravvalutate, non sono così bravo.

 

[joe]

Questa è la soluzione/correzione che avevo applicato allo script proposto.

... è da completare.

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

 

[i legend]

Eccellente soluzione

 

[salvo50]

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

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

 

[i legend]

​
For P1 = 1 To 2 N(1) = Estratto(Es,R1,P1 ​​​​​​if n(1) >0 then
poi fai tutto uguale

 

[joe]

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.



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.

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.

 

[salvo50]

Ciao a Tutti.

Grazie!