Richiesta per Salvo50 o chi vuole

[solare]

Ok ti ringrazio ugualmente
per quello che hai fatto
Ciao

 

[i legend]

Felice di esserti stato utile. Buona notte .

 

[solare]

Ciao I Legend, questa mattina con calma sono riuscito a verificare le tue modifiche.
In sostanza le cinquine colorate sono quelle che nell'ultima estrazione hanno dato almeno un esito positivo di 1 numero.
Praticamente è quello che volevo, non avevo capito il perchè la colorazione non avveniva solo al numero sortito.
Comunque va bene anche così. Ti ringrazio ancora per questo aiuto.
Buona giornata

 

[i legend]

Buona giornata

 

[joe]

Ciao Solare,

Per colorare la cinquina ... bisogna scomporla nei suoi 5 numeri,

e poi, questi 5 devono essere "considerati" uno ad uno.

Lo script è lo stesso ma è molto (3 x 5) volte più complicato.

Attualmente abbiamo dato molti esempi di come si può fare.

Ho scritto spesso che non amo intervenire sui lavori, altrui perché è più complicato leggere / tradurre / interpretare /

ricavare i punti nodali agli incroci tra gli algoritmi utilizzati e le variabili coinvolte per applicare le nuove scelte risolutive.

Comunque sia ... ho aggiunto una funzione per colorare gli estratti sperando non sia sbagliata:

Option Explicit
' Non si garantisce che lo script dia risultati esatti
'  lo script è regalato cosi com è spetta all utilizzatore finale fare le verifiche
' l utilizatore fibnale è l unico  rsponsabile del suo utilizzo'
'https://forum.lottoced.com/threads/richiesta-per-salvo50-o-chi-vuole.2206986/'
' Script richiesto da utente solare LottoCed'
' lo script è stato modificato piu volte per aggiunte richieste  controllare ulteriormente se  i dati delle nuove richieste sono esatte '
Option Explicit
' Non si garantisce che lo script dia risultati esatti
'  lo script è regalato cosi com è spetta all utilizzatore finale fare le verifiche
' l utilizatore fibnale è l unico  rsponsabile del suo utilizzo'
'https://forum.lottoced.com/threads/richiesta-per-salvo50-o-chi-vuole.2206986/'
' Script richiesto da utente solare LottoCed'
' lo script è stato modificato piu volte per aggiunte richieste  controllare ulteriormente se  i dati delle nuove richieste sono esatte '
Sub Main
   Dim aN(1),N,idEstr,aR(1),i,col
   Dim Fin : Fin = EstrazioneFin
   Dim sE,nE
   aR(1) = GetRuote
   Scrivi "Ruota: " & NomeRuota(aR(1))
   Scrivi "IdEstr| Num|RitC.|IdEstr-1|    Cinquina1   |IdEstr-2|    Cinquina2   |IdEstr-3|    Cinquina3   |",1,,RGB(240,240,240)
   For N = 1 To 90
      aN(1) = N
      idEstr = SerieUltima(1,Fin,aN,aR,1)
      Scrivi idEstr & " |" & FormatSpace(Format2(N),3) & " |" & FormatSpace(Fin - idEstr,3) & " |",,0
      For i = 1 To 3
         ReDim aE(0): Call GetArrayNumeriRuota(idEstr - i,aR(1),aE)
         sE = StringaEstratti(idEstr - i,aR(1))
         Scrivi idEstr - i & "  | ",0,0
         Call Colora(sE,aR(1),Fin)
         Scrivi " | ",,0
      Next
      Scrivi
   Next
End Sub
Function GetRuote
   Dim r,c
   r = 11
   Do While r = 11
      r = ScegliRuota
      If r = 11 Then c = c + 1:Call MsgBox("La ruota Tutte non è Valida" & vbCrLf & "Seleziona Un altra Ruota" & vbCrLf & "Restano " &(3 - c) & " tentativi",vbOKOnly," Informazione")
      If c > 2 Then r = 1: Exit Do
   Loop
   GetRuote = r
End Function
Function Colora(sE,R,Fin) ' By Joe 
   Dim E,P,G,Gr,C
   E = Split("0." & sE,".")
   For P = 1 To 5
      Gr = 5 : If Posizione(Fin,R,E(P)) > 0 Then Gr = 4 : G = 1 : C = 2
      Scrivi Format2(E(P)),G,0,Gr,C
      Gr = 5 : G = 0 : C = 0
      If P < 5 Then Scrivi ".",0,0,Gr,C
   Next
End Function

 

[i legend]

Ciao joe, ottima soluzione come sempre.
Avendo stabilito che avevo capito cosa serviva ,stamattina avevo pensato ad una soluzione . Diversa dalla tua,ma non ho verificato se funzia. Se così dovesse essere allora la posto, per avere un ulteriore soluzione
Grazie e ciao

 

[i legend]

Ciao Ecco la soluzione, l ho isolata tra i Rem
spiego per chi si avvicina agli script il filo logico seguito
Visto che devo evidenziare gli ultimi numeri estratti, allora dichiaro un vettore a 90
ciclo i i numeri sortiti nel vettore impostando il colore rosso cosi nel momento in cui vado ascrivere l estratto , quello avra il suo colore
nero se non è presente rosso se lo è , stesso discorso per il grassetto
carico all inizio per fare questo lavoro solo una volta, non utilizzo serieritardoturbo che per quanto veloce è sempre un calcolo impegnativo reiterato piu volte.
Se lo script che viene richiesto è chiaro e spiegato bene è piu facile pensare la soluzione dello script per chi lo lista, sicuramente non sara la soluzione piu ottimizzqata del mondo, ma sicuramente la migliore per chi lista.
Verificare sempre che i risultati siano esatti

Option Explicit
' Non si garantisce che lo script dia risultati esatti
'  lo script è regalato cosi com è spetta all utilizzatore finale fare le verifiche
' l utilizatore fibnale è l unico  rsponsabile del suo utilizzo'
'https://forum.lottoced.com/threads/richiesta-per-salvo50-o-chi-vuole.2206986/'
' Script richiesto da utente solare LottoCed'
' lo script è stato modificato piu volte per aggiunte richieste  controllare ulteriormente se  i dati delle nuove richieste sono esatte '
Sub Main
    Dim N,I,p,aSep
    Dim idestr,aR(1),aN(1)
    Dim Fin:Fin = EstrazioneFin
    Dim qEstr:qEstr = 4 ' posso cambiare il numero di estrazioni indietro da analizzare
    ' scelgo la ruota
    aR(1) = GetRuote
    '
    '
    aSep = Array("",".",".",".",".","") ' aRray che contirne i searatori della cinquina
    '  questa è la parte di codice che prende gli estratti da colorare
    '
    ' prendo l ultima estrazione che si vuole confrontare
    ReDim aU_Estr(0): Call GetArrayNumeriRuota(Fin,aR(1),aU_Estr)
    ReDim aColTx(90),aColBk(90),aBold(90) ' Dichiaro la Variabile che conterra il colore, e il grassetto
    ' imposto  a neutro i valori di default dello sfondo, lasciarlo a zero restituirebbe nero
    For N = 1 To 90
        aColBk(N) = 5
    Next
    ' imposto il colore dei numeri sortiti
    For N = 1 To 5
        aColTx(aU_Estr(N)) = 5' RGB(255,255,255)
        aColBk(aU_Estr(N)) = RGB(0,94,47)
        aBold(aU_Estr(N)) = 1
    Next
    '
    '
    '
    ' imposto il titolo del lavoro
    Scrivi " Ruota: " & NomeRuota(aR(1)) & "   |  Conc: " & Fin & "  |  " & StringaNumeri(aU_Estr,,True) & " | ",1,,RGB(0,128,192),5
    Scrivi
    Scrivi "IdEstr| Num|RitC.|",1,0,RGB(0,128,128),5
    For N = 1 To qEstr
        Scrivi "IdEstr-" & N & "|    Cinquina" & N & "   |",1,0,RGB(0,128,192),5
    Next
    Scrivi
    For N = 1 To 90
        aN(1) = N
        idestr = SerieUltima(1,Fin,aN,aR,1)
        Scrivi idestr & " | " & Format2(N) & " | " & FormatSpace(Fin - idestr,3) & " | ",1,0,,RGB(0,94,47)
        For I = 1 To qEstr
            Scrivi idestr - I & "  | ",,0
            ReDim aE(0): Call GetArrayNumeriRuota(idestr - I,aR(1),aE)
            For p = 1 To 5
                Scrivi Format2(aE(p)),aBold(aE(p)),0,aColBk(aE(p)),aColTx(aE(p))
                Scrivi aSep(p),,0
            Next
            Scrivi " | ",,0
        Next
        Scrivi
    Next
End Sub
'scelgo la ruota da studiare, faccio in modo di escludere la ruota TT che restituirebbe un errore
' dopo tre tentativi viene restituita la ruota di default la ruota di Bari
Function GetRuote
    Dim r,c
    r = 11
    Do While r = 11
        r = ScegliRuota
        If r = 11 Then c = c + 1:Call MsgBox("La ruota Tutte non è Valida" & vbCrLf & "Seleziona Un altra Ruota" & vbCrLf & "Restano " &(3 - c) & " tentativi",vbOKOnly," Informazione")
        If c > 2 Then r = 1: Exit Do
    Loop
    GetRuote = r
End Function

Grazie Joe, Fammi sapere che ne pensi

' P.s: mi fa molto piacere vedere che hai ripreso a "scriptare" , qui nel forum.
per chi vuole impare, e anche per chi è piu esperto , il confronto e gli script di alta qualità sono importanti
la tua funzione , funziona egregiamente , gioco di parole

 

[joe]

Ciao Ilegend,

Ci sono spesso molte soluzioni, alcune volte equivalenti,

oltre che nei risultati anche nella praticità e nel loro tempo di esecuzione.

Per cui stabilire quale sia la migliore è difficile o impossibile.

Per me spesso è scegliere ... la soluzione che so scrivere più facilmente,

o più velocemente, o che essendomi più "congeniale"mi è maggiormente gradita.

Va benissimo anche la tua soluzione.

Mentre per i colori ... è scelta e questione di gusto.

Oppure anche qui, per questioni di refrazione si possono gradire maggiormente alcuni toni maggiormente ad altri.

Nei 2 casi da noi proposti il tuo pare più adatto ad un ipermetrope o ad un presbite abituato ad una correzione piena.

In sintesi, forse gli unici aspetti ponderabili rimangono quelli relativi a rallentamenti introdotti da alcune scelte

ed alle velocità differenti / facilità di lettura / versatilità e possibilità di sviluppare successivamente la soluzione adottata.

Per me la tua soluzione è ottimale specie se poi dovessero essere grandi quantità di estrazioni.

Buon week-end a tutte/i.

PS: Ho modificato leggermente lo script che avevo proposto.

 

[solare]

Ciao Joe e I legend
Cosa dire da due bravissimi come voi
non ci si poteva aspettare di meglio.
Grazie

 

[i legend]

Grazie per il pollicione Salvo