Richiesta

[i legend]

Ciao a tutti
Joe purtroppo non sapendo cosa fare con la raccolta diventa arduo anche come stabilire la raccolta

per salvo posto uno script proprio basic per scrivere quando si verifica la condizione
verificare che non abbia fatto errori , l ho fatto , utilizzando i concetti logici del precedente script postato

Option Explicit
'Controllare che i dati restituiti siano esatti
' script richiesto da Bubblegum utente lottoced
Sub Main
   Dim IdEstr,Ini,Fin:Call ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin)
   Dim R:R = ScegliRuota:If R = 11 Then Exit Sub
   Dim CadSpia:CadSpia = CInt(InputBox("Cadenze:" & vbCrLf & "0,1,2,3,4,5,6,7,8,9","Seleziona la Cadenza da filtrare",0))
   Dim E1,E2,E3,M,T,N1,N2,N3,Id
   ReDim aComb(10),aSum(10),aCad(10),aNEstr(10)
   For IdEstr = Ini To Fin
      ReDim aEstr(0)
      Call GetArrayNumeriRuota(IdEstr,R,aEstr)
      If aEstr(1) Then ' se l estrazione esiste allora proseguo
         T = 0
         For E1 = 1 To 3 ' costruisco le terzine
            For E2 = E1 + 1 To 4
               For E3 = E2 + 1 To 5
                  N1 = Estratto(IdEstr,R,E1):N2 = Estratto(IdEstr,R,E2):N3 = Estratto(IdEstr,R,E3)
                  If N1 + N2 + N3 <= 90 Then  ' se la condizione somma è rispettata allora carico gli array
                     T = T + 1
                     aComb(T) = Format2(N1) & "." & Format2(N2) & "." & Format2(N3)
                     aSum(T) = Format2(N1 + N2 + N3)
                     aCad(T) = Cadenza(aSum(T))
                     aNEstr(T) = "E(" & E1 & "+" & E2 & "+" & E3 & ")"
                  End If
               Next
            Next
         Next
         If T = 1 Then  ' se è presente solo una somma '
            If aCad(T) = CadSpia Then  ' se la cadenza della somma è uguale a quella richiesta allora scrivi
               Id = Id + 1
               Scrivi FormatSpace(Id,4,1) & FormatSpace(IdEstr,5,1) & "   " & StringaNumeri(aEstr,,True) & "   " & aNEstr(T) & "  " & aComb(T) & "   " & aSum(T) & "   " & aCad(T)
            End If
         End If
      End If
      Call AvanzamentoElab(Ini,Fin,IdEstr)
   Next
End Sub

 

[i legend]

Joe il tuo script è super veloce

 

[salvo50]

Ciao I Leggend, grazie per l'ultimo script, è quasi uguale al mio, adesso devo capire perchè il mio è come un cane che si morde la coda ed invece il tuo funziona, quando ho visto che aveva postato Joe, ho pensato ci siamo adesso vedo dove sto sbagliando ed invece nonostante anche quello di Joe sia quasi l'essenziale, mi si è bruciata la lampadina, dopo che capirò il tuo mi butterò su quello di Joe per cercare di capire perchè a fatto 2 funzioni, comunque vi ringrazio a tutti e due, voi veramente siete dei maestri

 

[i legend]

Ciao Salvo,
per velocizzare lo script si potrebbe
inserire dopo
If somma <=90 Then
t =t+1
If t>1 Then Exit for
end If
Questo per evitare di analizzare tutti e 10 le formazioni se non serve
ma per trovare la differenza ho dovuto far girare lo script più volte .

quale problema riscontri?

credo che joe abbia creato le due funzioni per poter spiegare meglio il meccanismo. Dividendo il problema si semplifica .

ciao

p.s:
joe è il maestro della maggior parte di noi.
Luigi è il prof

 

[Roby]

Ciao a Tutti
Ciao Cerberus, non era mia intenzione sminuire il tuo script, se per te l'ho fatto, da parte mia è stato del tutto involontario, comunque ti chiedo scusa, poi io sono un dilettante nonostante siano passati quasi due anni e mezzo da quando ho chiesto il mio primo aiuto, lo dimostra il fatto che stavo per chiedere di nuovo aiuto perchè con l'ultimo aiuto di Joe sono riuscito a eliminare i doppioni, ma non ho eliminato il primo, dallo script di I Leggend cercherò di capire come ha fatto, anche se sarà arduo perchè per le mie conoscenze in fatto di script, è troppo raffinato, elegante, meraviglioso ecc...

Ciao salvo, io rispondevo a bubblegum.
Non mi sono per niente sentito sminuito, forse hai equivocato.
se tu sei un dilettante negli script, allora io cosa sono?
io non li utilizzo come gli altri, mi diverto soltanto.
Non farti problemi inesistenti.
ciao

 

[joe]

Ciao Salvo.

Buon giorno a tutte/i.

Quando prima di procedere , si guarda al fatto...

La prima funzione si assicura sia una sola occorrenza.

La seconda funzione cerca i numeri che avevano

creato la condizione unica.

Sembra più complicato .. ma è ... più semplice.

 

[salvo50]

Ciao Salvo.

Buon giorno a tutte/i.

Quando prima di procedere , si guarda al fatto...

La prima funzione si assicura sia una sola occorrenza.

La seconda funzione cerca i numeri che avevano

creato la condizione unica.

Sembra più complicato .. ma è ... più semplice.

Ciao Joe, grazie, cercherò di seguire questo ragionamento, io l'avevo abbandonato perchè mi stava andando il cervello in pappa, il secondo script di I Leggend e quasi identico a quello impostato da me solo c'è qualche differenza che per me è superflua, ma probabilmente non è così, sia tu che I Leggend mi avete dato tante spiegazioni con i vostri script, per questo non ho ritenuto opportuno insistere nel chiedere aiuto.

 

[joe]

... Ok ...

In questa nuova versione, come detto, ho unificato le 2 funzioni.

Quindi lo script è:

* più breve,

* più veloce,

* visualizza più risultati del precedente,

* i risultati sono già "organizzati".

Cioè i dati "a video" sono ANCHE subito fruibili per un possibile l'utilizzo e gli ulteriori sviluppi.

Dunque, a parere mio, è molto migliore,

anche se è un pochino più complicato e difficile ad interpretarsi.

Buona Giornata a tutte/i.

Option Explicit
Sub Main
'Terne Uniche con Somma Entro 90 e Cadenza scelta.
'Script By Joe    
   Dim Ini,Fin,Es,C,R,P,E(5),K,Nu
   Ini = EstrazioneFin - 155 : Fin = EstrazioneFin
   R = ScegliRuota
   C = InputBox("Scegli ?","CADENZA ",8)
   Scrivi UCase(NomeRuota(R)),True
   For Es = Ini To Fin ' Estrazione
      AvanzamentoElab Ini,Fin,Es
      'For R = 1 To 12 ' Ruota
      'If R = 11 Then R = 12
      If SommaEstratti(Es,R) > 0 Then ' Salta stazioni Vuote
         For P = 1 To 5 ' Posizione
            E(P) = Estratto(Es,R,P) ' Estratti
         Next ' P
         If Left(Unica_Terna(E),1) = C Then ' Cadenza
            K = K + 1
            Scrivi DataEstrazione(Es) & " " & SiglaRuota(R) & " " & StringaNumeri(E,,True) & " ",0,0
            Nu = Split(Unica_Terna(E),".") : Nu(0) = 0 ': OrdinaMatrice Nu,False
            Scrivi StringaNumeri(Nu,,True) & " " & CInt(Nu(1)) + CInt(Nu(2)) + CInt(Nu(3))
         End If 'Cadenza
      End If ' Validità
      'Next ' Ruota
   Next ' Estrazione
   Scrivi K & " casi."
End Sub
Function Unica_Terna(E)
   Dim a,b,c,s,t,u
   Unica_Terna = ""
   For a = 1 To 3
      For b = a + 1 To 4
         For c = b + 1 To 5
            s = E(a) + E(b) + E(c)
            If s <= 90 Then t = t + 1 : u = Cadenza(s) & "." & E(a) & "." & E(b) & "." & E(c)
         Next
      Next
   Next
   If t = 1 Then Unica_Terna = u
End Function

 

[i legend]

Ciao Joé
complimenti per i tuoi script , belli ed eleganti
sono d accordo con te
i dati dovrebbero essere sempre fruibili per le raccolta dati.
ho cercato una soluzione alternativa utilizzando la terzina come Array per le funzioni statistiche
Controllare salvo errori sempre possibili
a dopo

Option Explicit
'Controllare che i dati restituiti siano esatti
' script richiesto da Bubblegum utente lottoced
Sub Main
   Dim IdEstr,Ini,Fin:Call ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin)
   Dim R:R = ScegliRuota:If R = 11 Then Exit Sub
   Dim CadSpia:CadSpia = CInt(InputBox("Cadenze:" & vbCrLf & "0,1,2,3,4,5,6,7,8,9","Seleziona la Cadenza da filtrare",0))
   Dim E1,E2,E3,M,T,N1,N2,N3,Id,I,sum
   ReDim aComb(10),aSum(10),aCad(10),aNEstr(10)
   Dim aRt(1):aRt(1) = 11
   Call ResetTimer
   Scrivi NomeRuota(R),1
   For IdEstr = Ini To Fin
      ReDim aEstr(0)
      Call GetArrayNumeriRuota(IdEstr,R,aEstr)
      If aEstr(1) Then ' se l estrazione esiste allora proseguo
         T = 0:sum = 0
         For E1 = 1 To 3 ' costruisco le terzine
            For E2 = E1 + 1 To 4
               For E3 = E2 + 1 To 5
                  sum = aEstr(E1) + aEstr(E2) + aEstr(E3) 'Sommo le terzine
                  If sum <= 90 Then
                     T = T + 1 :If T = 2 Then Exit For ' se ci sono valori multipli scarto la combinazione
                     aComb(T) = Array(0,aEstr(E1),aEstr(E2),aEstr(E3)) ' Raccolgo i dati in vettore da poter utilizzare per le statistiche
                     aSum(T) = Format2(sum)
                     aNEstr(T) = "E(" & E1 & "+" & E2 & "+" & E3 & ")"
                  End If
               Next
               If T = 2 Then Exit For
            Next
            If T = 2 Then Exit For
         Next
         If T = 1 Then ' se è presente solo una somma '
            If Cadenza(aSum(T)) = CadSpia Then ' se la cadenza corrisponde
               Id = Id + 1
               Scrivi DataEstrazione(IdEstr) & "     " & StringaNumeri(aEstr,,True) & "   " & aNEstr(1) & "  " & StringaNumeri(aComb(1),,True) & "   " & aSum(1)
            End If
         End If
      End If
      Call AvanzamentoElab(Ini,Fin,IdEstr)
   Next
   Scrivi Id & "  Casi su "&NomeRuota(R)
   Scrivi "Tempo Impiegato: " & TempoTrascorso
End Sub

Sulla velocità non saprei dire , se è veloce come il tuo
ciao

 

[joe]

Ciao ...

Si, è anche un pò, più veloce del mio perché tu hai previsto ... di uscire ...

dai vari for-next in caso di somme plurime.

Siamo a trattare, in ogni, caso di velocità nell'ordine di 5-10 MILA estrazioni al secondo.

Dunque "1 secondo" ... per tutto ... un archivio di 10-Mila Estrazioni.

Tempi e velocità accettabili e più che buoni.

Nuovamente ... Bravo.

 

[i legend]

Grazie joe