Novità

Estrazione del Lotto

Su LottoCED puoi seguire le estrazioni del lotto in diretta tra

Evidenziare estratti Come fare

Xeroxs

Advanced Member
Buonasera a Tutti,
Dovrei evidenziare degli estratti voluti senza criterio, o meglio se volessi evidenziare il primo di Bari e d il secondo di Cagliari come posso fare, mi basterebbe colorarlo di Rosso, nell'elaborazione dei dati ci riesco ma volendo farlo stampando l'ultima estrazione in questo caso vorrei evidenziare alcuni estratti esiste un modo semplice per farlo, purtroppo non riesco a capire come posso intervenire, intanto che avevo il PC disponibile ho ripreso un metodo in cui ho bisogno di evidenziare dei numeri per non riempire lo script di descrizioni a varie.

Posto il piccolo script su cui intervenire, sperando sia possibile e sperando se si che qualcuno possa aiutarmi a capire come farlo

Codice:
Sub Main
   Dim nu(5),r,p
   Dim Ini,Fin,es
   Ini = EstrazioneFin
   Fin = EstrazioneFin
   For es = Ini To Fin
      Scrivi GetInfoEstrazione(es),1
      Scrivi
      For r = 1 To 12
         If r = 11 Then r = 12
         For p = 1 To 5
            nu(p) = Estratto(es,r,p)
         Next
         Scrivi SiglaRuota(r) & vbTab & StringaNumeri(nu,,1)
      Next
   Next
End Sub

Grazie come sempre.
 

i legend

Advanced Member >PLATINUM PLUS<
ciao Xerox
se non sappiamo cosa vuoi evidenziare come possiamo aiutarti?
devi evidenziare dei numeri o delle posizioni?

ora vado a letto che sono stanco se spieghi bene e non ti ha aiutato ancora nessuno , domani provo , se ne sono capace ovviamnte
ciao ;)
 

Xeroxs

Advanced Member
Grazie I-Legend
Vorrei evidenziare nelle estrazioni che andrò ad esaminare
Il primo ed il quinto estratto di Bari
Il secondo ed il quarto estratto di Cagliari
Il 3 estratto di Firenze
Il secondo ed il quarto estratto di Genova
Il primo ed il quinto estratto di Milano
Formando una croce degli estratti da esaminare.
Sperando che sia possibile farlo.
:)
 

i legend

Advanced Member >PLATINUM PLUS<
Ciao Xerox guarda se cosi ti va bene
non ho capito l utilita della x
se non vuoi evidenziare gli estratti basta una piccola modifica all if
ecco lo script
ora corro a nanna
se ci sono errori ci pensiamo Domani :)
Codice:
Option Explicit
'Grazie I-Legend
'Vorrei evidenziare nelle estrazioni che andrò ad esaminare
'Il Primo ed il quinto Estratto di Bari
'Il secondo ed il quarto Estratto di Cagliari
'Il 3 Estratto di Firenze
'Il secondo ed il quarto Estratto di Genova
'Il Primo ed il quinto Estratto di Milano
'Formando una croce degli estratti da esaminare.
'Sperando che sia possibile farlo.
'
'
'controllare eventuali bugs'
Sub Main
   ReDim aEstrVer(0),aEv(55)
   Dim E,sEstr
   Dim aCol(1)
   Dim R,p,m
   Dim idestr:idestr = EstrazioneFin
   Call ScegliEstratti(aEstrVer,sEstr)
   For E = 1 To UBound(aEstrVer)
      aEv(aEstrVer(E)) = 1
   Next
   Scrivi sEstr
   Scrivi
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi FormatSpace(NomeRuota(R),12) & " | ",,0
      For p = 1 To 5
         m = m + 1
         If aEv(m) Then aCol(1) = vbRed :Else aCol(1) = RGB(239,240,242)
         Scrivi " " & Format2(Estratto(idestr,R,p)) & " ",,0,aCol(1)
      Next
      Scrivi
   Next
End Sub
Sub ScegliEstratti(aEstrVer,sEstr)
   ReDim aVoci(55)
   ReDim aVociSel(55)
   Dim R,m,p
   For R = 1 To 12
      If R = 11 Then R = 12
      For p = 1 To 5
         m = m + 1
         aVoci(m) = p & SiglaRuota(R)
         
         
      Next
   Next
   m = 0
   sEstr = ""
   If ScegliDaLista(aVoci,aVociSel,"Seleziona Estratti di Verifica") >= 0 Then
      For p = 1 To UBound(aVoci)
         If aVociSel(p) Then
            m = m + 1
            ReDim Preserve aEstrVer(m)
            aEstrVer(m) = p
            sEstr = sEstr & aVoci(p) & "  "
         End If
      Next
   End If
End Sub
 
Ultima modifica:

GioRyuKen72

Advanced Member
Ciao Xerox guarda se cosi ti va bene
non ho capito l utilita della x
se non vuoi evidenziare gli estratti basta una piccola modifica all if
ecco lo script
ora corro a nanna
se ci sono errori ci pensiamo Domani :)
Codice:
Option Explicit
'Grazie I-Legend
'Vorrei evidenziare nelle estrazioni che andrò ad esaminare
'Il Primo ed il quinto Estratto di Bari
'Il secondo ed il quarto Estratto di Cagliari
'Il 3 Estratto di Firenze
'Il secondo ed il quarto Estratto di Genova
'Il Primo ed il quinto Estratto di Milano
'Formando una croce degli estratti da esaminare.
'Sperando che sia possibile farlo.
'
'
'controllare eventuali bugs'
Sub Main
   ReDim aEstrVer(0),aEv(55)
   Dim E,sEstr
   Dim aCol(1)
   Dim R,p,m
   Dim idestr:idestr = EstrazioneFin
   Call ScegliEstratti(aEstrVer,sEstr)
   For E = 1 To UBound(aEstrVer)
      aEv(aEstrVer(E)) = 1
   Next
   Scrivi sEstr
   Scrivi
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi FormatSpace(NomeRuota(R),12) & " | ",,0
      For p = 1 To 5
         m = m + 1
         If aEv(m) Then aCol(1) = vbRed :Else aCol(1) = RGB(239,240,242)
         Scrivi " " & Format2(Estratto(idestr,R,p)) & " ",,0,aCol(1)
      Next
      Scrivi
   Next
End Sub
Sub ScegliEstratti(aEstrVer,sEstr)
   ReDim aVoci(55)
   ReDim aVociSel(55)
   Dim R,m,p
   For R = 1 To 12
      If R = 11 Then R = 12
      For p = 1 To 5
         m = m + 1
         aVoci(m) = p & SiglaRuota(R)
        
        
      Next
   Next
   m = 0
   sEstr = ""
   If ScegliDaLista(aVoci,aVociSel,"Seleziona Estratti di Verifica") >= 0 Then
      For p = 1 To UBound(aVoci)
         If aVociSel(p) Then
            m = m + 1
            ReDim Preserve aEstrVer(m)
            aEstrVer(m) = p
            sEstr = sEstr & aVoci(p) & "  "
         End If
      Next
   End If
End Sub
.. 🤗 bello i Legend, per me è troppo !!
io avevo preparato questo (statico..senza possibilià di scelta), ma è nulla a confronto del tuo:

1614543484257.png

..prenderò spunti.

Gio.
 

Xeroxs

Advanced Member
Ciao Gio,
Purtroppo ora non posso controllare con il PC, ma vorrei capire anche la tua soluzione se vuoi postarla, in quanto a volte anche le soluzioni "statiche" per piccole soluzioni vanno bene.
Concordo per quanto fatto da I-Legend è davvero bravo. E dai suoi lavori cerco di capire le vere potenzialità del programma.
Appena posso verifico il tutto anche la tua soluzione se vorrai.
Grazie ad entrambi
 

GioRyuKen72

Advanced Member
Ciao Xeroxs, molte volte tento di fare gli script per testare le mie capacità.
Mi limito a fare quelli semplici..
Codice:
Sub Main
   ' https://forum.lottoced.com/threads/evidenziare-estratti-come-fare.2199061/
   ColoreTesto 0
   Scrivi "                            Metodo EVIDENZIARE GLI ESTRATTI A X DI XEROXS -- listato GioRyuKen72                              ",1,,2,5
   Scrivi "https://forum.lottoced.com/threads/evidenziare-estratti-come-fare.2199061/",1
   Scrivi
   ColoreTesto 0
   Dim R1,ruo(3),RuoABT(1),Nn(2),E1,E2,P1,P2,P3,P4,P5,P6,P7,P8,P9,P10,P11,a,b,Cap,Abb1,Abb2
   Dim Terzina1(3),ambo1(2),ambo2(2),PostaA(2),PostaABT(1),PostaT(3),ambata1(2)
   Dim Somma15,Ba1,Ba5,Ca2,Ca4,Fi3,Ge2,Ge4,Mi1,Mi5
   ex = CInt(InputBox("Quante estrazioni controllo?","Estrazioni",1))
   ini = EstrazioneFin - ex
   fin = EstrazioneFin
   For es = ini To fin
      For P1 = 1 To 1
         For P2 = 2 To 2
            For P3 = 3 To 3
               For P4 = 4 To 4
                  For P5 = 5 To 5
                     Messaggio es
                     Ba1 = Estratto(es,1,P1)
                     Ba5 = Estratto(es,1,P5)
                     Ca2 = Estratto(es,2,P2)
                     Ca4 = Estratto(es,2,P4)
                     Fi3 = Estratto(es,3,P3)
                     Ge2 = Estratto(es,4,P2)
                     Ge4 = Estratto(es,4,P4)
                     Mi1 = Estratto(es,5,P1)
                     Mi5 = Estratto(es,5,P5)
                     '______________________________________
                     Scrivi("Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                     Scrivi
                     Scrivi "  " & SiglaRuota(1) & " ",1,0
                     For P6 = 1 To 5
                        E1 = Estratto(Es,1,P6)
                        If E1 = Ba1 Or E1 = Ba5 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(2) & " ",1,0
                     For P7 = 1 To 5
                        E1 = Estratto(Es,2,P7)
                        If E1 = Ca2 Or E1 = Ca4 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(3) & " ",1,0
                     For P8 = 1 To 5
                        E1 = Estratto(Es,3,P8)
                        If E1 = Fi3 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(4) & " ",1,0
                     For P9 = 1 To 5
                        E1 = Estratto(Es,4,P9)
                        If E1 = Ge2 Or E1 = Ge4 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(5) & " ",1,0
                     For P10 = 1 To 5
                        E1 = Estratto(Es,5,P10)
                        If E1 = Mi1 Or E1 = Mi5 Then
                           ColoreTesto 2
                        Else
                           ColoreTesto 0
                        End If
                        Scrivi Format2(E1) & " ",1,0
                        ColoreTesto 0
                     Next
                     Scrivi
                     Scrivi "  " & SiglaRuota(6) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,6," "),1
                     Scrivi "  " & SiglaRuota(7) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,7," "),1
                     Scrivi "  " & SiglaRuota(8) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,8," "),1
                     Scrivi "  " & SiglaRuota(9) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,9," "),1
                     Scrivi "  " & SiglaRuota(10) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,10," "),1
                     Scrivi "  " & SiglaRuota(12) & " ",1,0
                     Scrivi "" & StringaEstratti(ES,12," "),1
                     Scrivi String(24,"-"),1,,,0
                     ' Scrivi String(70,"-"),1
                     'ColoreTesto 1
                     ' Scrivi "CONDIZIONE RILEVATA: " & Format2(Nn(1)) & "  +  " & Format2(Nn(2)) & "  =   " & Format2(Somma15),1,0
                     ' ColoreTesto 0
                     ' Scrivi
                     ' Scrivi String(70,"-"),1
                     ' Scrivi "Capigioco  : " & Format2(Cap),1
                     ' Scrivi "Abbinamenti: " & Format2(Abb1) & " e " & Format2(Abb2),1
                     ' ColoreTesto 0 : Scrivi String(70,"-"),1
                     ' Scrivi
                     'Gioca es,True,,1
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit For
   Next
   Scrivi
   Scrivi "Casi totali (" & casi & ")",1
   TestoInBandaPassante " *****  EVIDENZIARE GLI ESTRATTI A X DI XEROXS  -- listato GioRyuKen72 ***** ",1,3,0
   ScriviDistribuzioneEsiti(True)
   ScriviDistribuzioneCasiInCorso(True)
   ScriviResoconto
End Sub

Gio.
 

Xeroxs

Advanced Member
Ciao a Tutti e Buongiorno.
Che Dire ho lanciato gli Script di Entrambi e di Questo Vi Ringrazio,
Davvero Che Dire I-Legend Proponi sempre dei lavori e delle soluzioni sempre ad un Livello che Io neanche immaginavo il programma potesse esprimere, evidentemente hai così bene assorbito la materia fino a dare sfogo ad ogni possibile soluzione dalla più banale alla più complessa come ho visto dai Tuoi Lavori, davvero Bravo.
Con Questo Ovvio è Anche utile quanto fatto da Giò, Devo infatti anche pensare che se sviluppo poi uno script-Metodo e se devo passarlo alla mia amica non masticando molto di Script devo proporre qualcosa anche basato sulle basi.
Grazie Davvero Giò, Sarà anche Utile la tua soluzione, e da quel che vedo entrambe le soluzioni saranno davvero utili per me per apprendere sempre qualcosa di Nuovo.
Come mi ricorda spesso anche Claudio8, che saluto l'help che viene proposto dal programma è davvero utile e ben esposto, infatti lo sto visionando anche su Voci ancora mai utilizzate, ma non tutto come ovvio può essere riportato è quì entrate Voi con le Vostre soluzioni per supportare Me e quelli meno, a Volte molto meno esperTi.

Grazie Ancora
 

i legend

Advanced Member >PLATINUM PLUS<
Ciao a tutti.
Se si dovesse fare una ricerca su più estrazioni lo script andrebbe ottimizzato.
Se qualcuno vuole cimentarsi , utilizzando la stessa logica , con qualche piccolo accorgimento ci si riesce facilmente.
Altrimenti lo posto io , è davvero solo un piccolo accorgimento.
Buon lavoro. :)
 

joe

Advanced Member >PLATINUM<
Buona serata a tutte/i.

Codice:
Sub Main
   For R = 1 To 5
      A = FuoriX(R,5) : B = FuoriX(6 - R)
      For P = 1 To 5
         If P = A Or P = B Then Scrivi SiglaRuota(R) & " ",0,0 Else Scrivi Space(3),0,0
      Next
      Scrivi
   Next
End Sub

Così com'è gira solo su Spaziometria.

:)
 

Xeroxs

Advanced Member
Ciao Joe,
Non è solo un semplice gradimento, Esponi sempre spunti che per chi ha voglia di apprendere è un ottimo stimolo, preso da questo ho creato una base per portare avanti e/o migliorare un metodo che devo fare.

Codice:
Sub Main
   Dim Ini,Fin,es,K
   Dim R,P
   Dim A,B
   Ini = EstrazioneFin - 1
   Fin = EstrazioneFin
   For es = Ini To Fin
      ColoreTesto 1
      K = K + 1
      Scrivi "Estrazione n." & Format2(es) & " Del " & DataEstrazione(es) & " " & String(80,"*") & " Caso n°" & Format2(K),1
      Scrivi
      For R = 1 To 5
         A = FuoriX(R,5) : B = FuoriX(6 - R)
            Scrivi SiglaRuota(R) & " ",1,False
      Next
      Scrivi
      For R = 1 To 5
         A = FuoriX(R,5) : B = FuoriX(6 - R)
         For P = 1 To 5
            ColoreTesto 2
            If P = A Or P = B Then Scrivi Estratto(es,R,P) & " ",0,0 Else Scrivi Space(3),0,0
         Next
         Scrivi
      Next
      Scrivi
   Next
End Sub

Sempre preso da quanto creato e proposto da Te, ho provato a partire dalla ruota successiva ma non mi espone i valori nello stesso modo, puoi farmi capire il perchè, dove sbaglio?

Codice:
Sub Main
   Dim Ini,Fin,es,K
   Dim R,P
   Dim A,B
   Ini = EstrazioneFin - 1
   Fin = EstrazioneFin
   For es = Ini To Fin
      ColoreTesto 1
      K = K + 1
      Scrivi "Estrazione n." & Format2(es) & " Del " & DataEstrazione(es) & " " & String(80,"*") & " Caso n°" & Format2(K),1
      Scrivi
      For R = 2 To 6
         A = FuoriX(R,6) : B = FuoriX(7 - R)
            Scrivi SiglaRuota(R) & " ",1,False
      Next
      Scrivi
      For R = 2 To 6
         A = FuoriX(R,6) : B = FuoriX(7 - R)
         For P = 1 To 5
            ColoreTesto 2
            If P = A Or P = B Then Scrivi Estratto(es,R,P) & " ",0,0 Else Scrivi Space(3),0,0
         Next
         Scrivi
      Next
      Scrivi
   Next
End Sub

Ok per le ruote ma non per gli estratti corrispondenti, dovrei intervenire sulle posizioni ma non capisco come...
 

joe

Advanced Member >PLATINUM<
Ciao Xeroxs,

E' un pochino complicato spostare gli intervalli delle ruote.

Empiricamente si possono costruire dei "modelli" ed osservare cosa e come si devono modificare,

alcuni dei valori affinché tutto funzioni bene.

Dopo aver trovato l'algoritmo (cioè il modo con cui cambiano i valori al cambiare dell'intervallo di ruote)

cioè quando si è sintetizzato il modello matematico, si può inserirlo nei calcoli della funzione "visualizza X".

Teoricamente si può (e qualcuno ne è sicuramente capace di) costruire a mente il tutto come opera di ingenio

Tuttavia, reputo sia oltre i miei limiti e/o la mia voglia di verificarlo.

Dunque ti propongo solo il primo step-up di quanto ho appena proposto.

Codice:
Option Explicit
Sub Main
  Dim E,R,P,A,B
  For R = 2 To 6
    Scrivi SiglaRuota(R),1,0
    A = FuoriX(R,6) : B = FuoriX(7-R)
    For P = 1 To 5
      E = Estratto(EstrazioneFin,R,P)
      If P = A-1 Or P = B Then
        Scrivi Space(1) & Format2(E),1,0,,2
      Else
        Scrivi Space(1) & Format2(E),0,0
      End If
    Next
    Scrivi
  Next
End Sub

:)
 
Ultima modifica:

Xeroxs

Advanced Member
Che Dire, Sembro un bambino difronte alla agognata cioccolata che tanto bramavo... :)
Sempre preciso/bravo nell' esporre soluzioni ottimali
 

joe

Advanced Member >PLATINUM<
Ringrazio nuovamente per la stima e per l'attenzione.

Come ho accennato e scritto molto-molto tra le righe, principalmente ci sono 5 script.

Il primo inizia da Bari il secondo da Cagliari, ecc. ecc.

Quindi fatti i 5 script si può richiamare quello che inizia con la "ruota giusta".

Fatto questo basta osservare cosa cambia in tutti questi script dall'uno all'altro

e poi agire di conseguenza per averne uno solo richiamabile in funzione della ruota iniziale.

per esempio tra il primo ed il secondo ci sono queste differenze:

A = FuoriX(R,5) : B = 6 - R

A = FuoriX(R,6) : B = 7-R



If P = A Or P = B Then

If P = A-1 Or P = B Then


Quando, si riesce a trovare il modo capace di descrivere ... questi cambiamenti ...

si possono unificare tutti e 5 in una sola routine.


:)
 
Ultima modifica:

Master

Advanced Member >GOLD<
Ciao a tutti
Grazie Joe per averci regalato questa nuova formula
con un po di fatica sono riuscito a lavorare con tutte e 11 le ruote :)
sempre preziosi i tuoi consigli senza nulla togliere alla competenza di ilegend,Mike58,Claudio, ed altri maestri
 

joe

Advanced Member >PLATINUM<
In questa nuova versione ... (Ringraziando Master per la fatica parallela)

ho riassunto quanto era in ipotesi di potersi realizzare.

Attenzione: Non ho imposto limitazioni e verifica per altre ruote,

quindi funziona solo per il quadro estrazionale a 10 ruote.

Codice:
Option Explicit
Sub Main
Dim Es,R
Es = EstrazioneFin
For R = 1 To 5
Call VisualizzaX (Es,R)
Next
End Sub

Function VisualizzaX (Es,R)
  Dim E,P,A,B,L,M,X
  L = R : M = R + 4
  Scrivi DataEstrazione (Es,,,"/"),True
  For X = L To M
    Scrivi SiglaRuota(X),1,0
    A = FuoriX(X,5+R) : B =  M+1-X
    For P = 1 To 5
      E = Estratto(Es,X,P)
      If P = A-R+1 Or P = B Then
        Scrivi Space(1) & Format2(E),1,0,,2
      Else
        Scrivi Space(1) & Format2(E),0,0
      End If
    Next
    Scrivi
  Next
  Scrivi Scrivi
End Function

:)
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 17 aprile 2021
    Bari
    59
    61
    41
    04
    32
    Cagliari
    10
    68
    19
    11
    85
    Firenze
    41
    01
    13
    73
    47
    Genova
    44
    30
    39
    88
    90
    Milano
    67
    88
    33
    13
    32
    Napoli
    44
    41
    79
    80
    66
    Palermo
    15
    59
    04
    31
    21
    Roma
    46
    68
    56
    78
    58
    Torino
    09
    15
    84
    17
    32
    Venezia
    81
    04
    84
    42
    35
    Nazionale
    52
    16
    63
    62
    46
    Estrazione Simbolotto
    Genova
    38
    36
    41
    17
    13

Ultimi Messaggi

Alto