Per Salvo50 o chi vuole

solare · 11 Marzo 2022

Ciao, chiedo agli esperti di listati, quanto segue:
Inserisco un numero, il listato mi dovrà mostrare ruota per ruota le ultime 5 estrazioni dove è presente il numero da me inserito.
evidenziando eventuali numeri ripetuti nelle cinquine.
Spero sia fattibile
Grazie

salvo50 · 14 Marzo 2022

Ciao a Tutti

Ciao Solare, non ho calcolato 5 uscite del numero da cercare, ma tutte quelle che trova in un certo
numero di estrazione che puoi variare a piacere, si può fare di cercarne solo 5 come da te richiesto
però per me è più facile farlo così, naturalmente puoi variare anche il numero da cercare.

Codice:

Option Explicit
Sub Main()
   Dim Num,R,Estr,Es,P,E,x
   Dim Nu(1),Ru(1)
   Num = CInt(InputBox("Quale Numero Cercare ",,77))
   Estr = CInt(InputBox("Quante estrazioni",,400))
   Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA SOLARE - SCRIPT Salvo50" & Space(14),1,,4,,3,,1
   Nu(1) = Num
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi String(53,"x")&"  " & NomeRuota(R),1,,,1
      For Es = EstrazioneFin - Estr To EstrazioneFin
         Ru(1) = R
         If SerieFreq(Es,Es,Nu,Ru,1) = 1 Then
            Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E = Estratto(Es,R,P)
               If E = Num Then
                  ColoreTesto 2
               Else
                  ColoreTesto 0
               End If
               Scrivi Format2(E) & " ",1,0
               ColoreTesto 0
            Next
            Scrivi
         End If
      Next
   Next
End Sub

solare · 14 Marzo 2022

Ciao Salvo50
Grazie lo stesso.

Mike58 · 14 Marzo 2022

Per salvo, soluzione fermata ciclo ai casi voluti

Codice:

Option Explicit
Sub Main()
   Dim Num,R,Estr,Es,P,E,x,k
   Dim Nu(1),Ru(1),casi
   Num = CInt(InputBox("Quale Numero Cercare ",,77))
   Estr = CInt(InputBox("Quante estrazioni",,400))
   casi = CInt(InputBox("Quanti casi Visualizzo",,5))
   Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA SOLARE - SCRIPT Salvo50" & Space(14),1,,4,,3,,1
   Nu(1) = Num
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi String(53,"x") & "  " & NomeRuota(R),1,,,1
      For Es = EstrazioneFin To EstrazioneFin - Estr Step - 1
         Ru(1) = R
         If SerieFreq(Es,Es,Nu,Ru,1) = 1 Then
            k = k + 1 ' conteggio i casi
            If k > casi Then Exit For ' esco dal ciclo for se superiore ai casi scelti
            Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E = Estratto(Es,R,P)
               If E = Num Then
                  ColoreTesto 2
               Else
                  ColoreTesto 0
               End If
               Scrivi Format2(E) & " ",1,0
               ColoreTesto 0
            Next
            Scrivi vbTab & k,1,0
            Scrivi
         End If
      Next
      'k = 0
      k = 0
   Next
End Sub

salvo50 · 14 Marzo 2022

Ciao Mike, quindi bastava mettere un contatore e fare la ricerca a ritroso, grazie Mike, io avevo pensato a soluzioni cervellotiche che alla fine ci ho rinunciato.

solare · 15 Marzo 2022

Ciao Mike58, ottimo lavoro, grazie infinite
Vista la tua non poca bravura
ti chiedo, anzichè colorare il numero di ricerca nel caso specifico è il 77, non puoi fare in modo da colorare solo i numeri che si sono ripetuti sulle cinquine ? in questo modo sappiamo quali numeri possono essere usati con il proprio numero da mettere in gioco.
esempio nel caso specifico sulla ruota di bari il numero 7 e 12 sono sortiti 2 volte, in questo caso si evidenziano solo questi due numeri.

salvo50 · 15 Marzo 2022

Ciao Solare, e se i numeri doppi sono 3 oppure di più, quali deve colorare?
Secondo me, bisogna rifare un altro script, sarebbe bello se Mike con
l'aggiunta di qualche riga risolvesse la tua richiesta.

solare · 15 Marzo 2022

salvo50 ha scritto:
Ciao Solare, e se i numeri doppi sono 3 oppure di più, quali deve colorare?
Secondo me, bisogna rifare un altro script, sarebbe bello se Mike con
l'aggiunta di qualche riga risolvesse la tua richiesta.

Ciao Salvo50, non importa se sono 3 o più. Si colorano tutti quei numeri che sono più volte presenti nelle 5 cinquine.

Mike58 · 15 Marzo 2022

Con le colorazioni in questi costrutti neanche io trovo il bandolo della matassa, pertanto mi limito ad estrapolare i numeri ripetuti nelle estrazioni spia.
Magari Salvo poi trova il giusto confronto.

Codice:

'Option Explicit
Sub Main()
   Dim Num,R,Estr,Es,P,E,x,k,freq(90)
   Dim Nu(1),Ru(1),casi,vetN,VetQ
   Num = CInt(InputBox("Quale Numero Cercare ",,77))
   Estr = CInt(InputBox("Quante estrazioni",,400))
   casi = CInt(InputBox("Quanti casi Visualizzo",,5))
   Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA SOLARE - SCRIPT Salvo50" & Space(14),1,,4,,3,,1
   Nu(1) = Num
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi String(53,"x") & "  " & NomeRuota(R),1,,,1
      For Es = EstrazioneFin To EstrazioneFin - Estr Step - 1
         Ru(1) = R
         If SerieFreq(Es,Es,Nu,Ru,1) = 1 Then
            k = k + 1 ' conteggio i casi
            If k > casi Then Exit For ' esco dal ciclo for se superiore ai casi scelti
            Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E = Estratto(Es,R,P)
               If E = Num Then
                  ColoreTesto 2
               Else
                  ColoreTesto 0
               End If
               If EstrattoFrequenza(R,E,EstrazioneFin - Estr,EstrazioneFin) > 1 Then
                  kk = kk + 1
                  ReDim Preserve aNum(kk)
                  aNum(kk) = E
               End If
               Scrivi Format2(E) & " ",1,0
               ColoreTesto 0
            Next
            '--------------------------------------
            Scrivi vbTab & k,1,0
            Scrivi
         End If
      Next
      'Scrivi StringaNumeri(aNum)
      Call NumeriRipetutiRilevatiV(aNum,vetN,VetQ)
      Scrivi " Numeri Ripetuti Rilevati................................... " & StringaNumeri(vetN,,1),1
      Scrivi " Quantità numeri Rilevati................................... " & StringaNumeri(VetQ,,1)
      kk = 0
      k = 0
   Next
End Sub

solare · 15 Marzo 2022

Ciao Mike58, ottima anche questa tua idea
Grazie

salvo50 · 16 Marzo 2022

Ciao a Tutti

Grande Mike, i tuoi interventi sono sempre istruttivi

i legend · 16 Marzo 2022

Ciao , mike in pratica sono gli abbinamenti del numero.
Li trovi con un range di ricerca .
Selezioni quelli >=2 e quando fai lo script evidenzi solo quelli.

i legend · 16 Marzo 2022

Ciao a tutti

trivellatomariotretre33 · 16 Marzo 2022

Complimenti mike58 e salvo50 e complimenti a solare x l'intuizione.
Vorrei chiedere agli esperti di listati, Mike e salvo
se possibile inserire la possibilità dell'analisi anche per mese.
Grazie

Mike58 · 16 Marzo 2022

Ciao a Trivellato e tutti, bisogna puntualizzare, uno script nasce con un progetto definito, in quanto con esso poi bisogna definire il costrutto o organigramma costruttivo, ed ognuno degli scripter leggendo il progetto, se stimolante ha già chiaro mentre legge il modus operandi ed i codici da usare.
Da qui prende vita lo script, certo che poi dalle estrazioni spia alle estrazioni mese il discorso si complica e non è facile con quello script fare altre operazioni per rilevare altre risultanze.
Non sto dicendo che non si possa fare ma è veramente tutto un altro script.

Quindi... vi do un consiglio è sempre meglio fare una richiesta ex novo con le specifiche del progetto ben definito e sperare che qualcuno anche più giovane... sia stimolato ad intervenire.

Ciao

trivellatomariotretre33 · 16 Marzo 2022

grazie Mike58 (se ai pronto qualcosa di simile ------.........)
speriamo .

Mike58 · 16 Marzo 2022

Di pronto non c'è ne mai ad oc.
ho dovuto mettere le mani sullo script esistente, per fortuna era semplice, anche se non amo rimettere le mani su script esistenti con finalità diverse.

prova

Codice:

'Option Explicit
Sub Main()
   Dim Num,R,Estr,Es,P,E,x,k,freq(90)
   Dim Nu(1),Ru(1),casi,vetN,VetQ
   Num = CInt(InputBox("Quale Numero Cercare ",,77))
   Estr = CInt(InputBox("Quante estrazioni",,1800))
   casi = CInt(InputBox("Quanti casi Visualizzo",,15))
   ms = CInt(InputBox("Quale mese vusualizzo",,Month (Now)))
   Scrivi Space(14) & " NUMERO UGUALE IN TUTTE LE RUOTE - CHIESTO DA SOLARE - SCRIPT Salvo50" & Space(14),1,,4,,3,,1
   Nu(1) = Num
   For R = 1 To 12
      If R = 11 Then R = 12
      Scrivi String(53,"x") & "  " & NomeRuota(R),1,,,1
      For Es = EstrazioneFin To EstrazioneFin - Estr Step - 1
      If Mese(Es) = ms Then
         Ru(1) = R
         If SerieFreq(Es,Es,Nu,Ru,1) = 1 Then
            k = k + 1 ' conteggio i casi
            If k > casi Then Exit For ' esco dal ciclo for se superiore ai casi scelti
            Scrivi(" Estrazione n." & FormattaStringa(Es,"00000") & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E = Estratto(Es,R,P)
               If E = Num Then
                  ColoreTesto 2
               Else
                  ColoreTesto 0
               End If
               If EstrattoFrequenza(R,E,EstrazioneFin - Estr,EstrazioneFin) > 1 Then
                  kk = kk + 1
                  ReDim Preserve aNum(kk)
                  aNum(kk) = E
               End If
               Scrivi Format2(E) & " ",1,0
               ColoreTesto 0
            Next
            '--------------------------------------
            Scrivi vbTab & k,1,0
            Scrivi
         End If
         End If
      Next
      'Scrivi StringaNumeri(aNum)
      Call NumeriRipetutiRilevatiV(aNum,vetN,VetQ)
      Scrivi " Numeri Ripetuti Rilevati................................... " & StringaNumeri(vetN,,1),1
      Scrivi " Quantità numeri Rilevati................................... " & StringaNumeri(VetQ,,1)
      kk = 0
      k = 0
   Next
End Sub

trivellatomariotretre33 · 16 Marzo 2022

Scusa Mke va bene lo stesso .
Avevo sbagliato nel dire
invece del mese,
intendevo ( ambata a id mensile )
poi il seguito come era
ti invio una stretta di mano chilometrica .

trivellatomariotretre33 · 16 Marzo 2022

Scusami Ancora Mike58 cambiando il numero di ricerca mi da errore
allego foto

trivellatomariotretre33 · 16 Marzo 2022

e ok MIke avevo poce estrazioni

Per Salvo50 o chi vuole

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Premium Member

Premium Member

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Super Member >PLATINUM<

Super Member >PLATINUM<

Allegati

Super Member >PLATINUM<