Richiesta listato x I legend o chi ha capacità

[solare]

Ciao, nella speranza che qualche amico del forum abbia la voglia di farlo, indico cosa deve fare lo script.
In pratica, indico la ruota da elaborare, inserisco l'ambo interessato e l'elaborazione deve andare a verificare
e visualizzare le cinquine sortite alla -1,-2 e -3.
faccio un esempio mettiamo che l'ambo in questione sia 11-40 sulla ruota di bari nell'estrazione del 24/11/22
alla -1 troviamo la cinquina 85-24-10-29-59 alla -2 cinquina 74-16-60-71-72 e alla -3 20-22-71-49-30.
Ultima chicca potrebbe essere come ha fatto l'amico "I Legend" nel listato precedente, cioè mostrare l'ultima cinquina sortita
dell'ultima estrazione ed eventualmente se presenti colorare i numeri uguali alle tre cinquine .
Questo modo di ricerca sembra sia valido in quanto ho notato che spesso i numeri anticipano la sortita, ma la ricerca si deve basare solo sulle cinquine indicate alla -1,-2 e -3.

 

[i legend]

Ciao Solare, ho il PC morto, quindi non riesco. Non puoi modificare l altro o è una ricerca diversa?

 

[solare]

Non ho le capacità di modificare l'altro.
La ricerca non riguarda il singolo numero ma l'ambo. Come nell'esempio che ho riportato.
Grazie comunque

 

[lotto_tom75]

Non ho le capacità di modificare l'altro.
La ricerca non riguarda il singolo numero ma l'ambo. Come nell'esempio che ho riportato.
Grazie comunque

Non sono sicuro di aver capito quello che vuoi ma intanto dimmi se ti potrebbe andare bene questo

Option Explicit
Sub Main
   'by tom's bakery x solare :)
   Dim idEstr,k,e,nSpia
   Dim Rt(1)
   Dim nEntroColpi
   Dim aFrzSpia(2)
   Dim nPuntiMinSuFrz
   Dim p
   Dim Rt0
   Dim estratti
   Dim esito
   Dim entroilcolpo
   Dim idesuscita
   Dim numeriestratti
   Dim sorte
   nPuntiMinSuFrz = 2
   ReDim aPresenze(90)
   ScegliNumeri(aFrzSpia)
   Rt0 = ScegliRuota
   Rt(1) = Rt0
   For idEstr = EstrazioneIni To EstrazioneFin
      p = 0
      For e = 1 To UBound(aFrzSpia)
         If IsNumeroPresenteInEstrazione(idEstr,Rt0,aFrzSpia(e),0) Then
            p = p + 1
         End If
      Next
      If p >= nPuntiMinSuFrz Then
         Scrivi
         Call GetArrayNumeriRuota(idEstr,Rt0,numeriestratti)
         Scrivi "<font color=red>Estrazione e ruota di rilevamento ambo spia scelti per il rilevamento " & NomeRuota(Rt0) & " - " & StringaNumeri(aFrzSpia)
         Scrivi
         Scrivi NomeRuota(Rt0) & " - " & StringaNumeri(numeriestratti) & " - " & GetInfoEstrazione(idEstr)
         Scrivi
         Scrivi "Successive 5 estrazioni sulla ruota target di analisi"
         Scrivi
         Call GetArrayNumeriRuota(idEstr + 1,Rt0,numeriestratti)
         Scrivi NomeRuota(Rt0) & " - " & StringaNumeri(numeriestratti) & " - " & GetInfoEstrazione(idEstr + 1)
         Call GetArrayNumeriRuota(idEstr + 2,Rt0,numeriestratti)
         Scrivi NomeRuota(Rt0) & " - " & StringaNumeri(numeriestratti) & " - " & GetInfoEstrazione(idEstr + 2)
         Call GetArrayNumeriRuota(idEstr + 3,Rt0,numeriestratti)
         Scrivi NomeRuota(Rt0) & " - " & StringaNumeri(numeriestratti) & " - " & GetInfoEstrazione(idEstr + 3)
         Call GetArrayNumeriRuota(idEstr + 4,Rt0,numeriestratti)
         Scrivi NomeRuota(Rt0) & " - " & StringaNumeri(numeriestratti) & " - " & GetInfoEstrazione(idEstr + 4)
         Call GetArrayNumeriRuota(idEstr + 5,Rt0,numeriestratti)
         Scrivi NomeRuota(Rt0) & " - " & StringaNumeri(numeriestratti) & " - " & GetInfoEstrazione(idEstr + 5)
      End If
      Call AvanzamentoElab(EstrazioneIni,EstrazioneFin,idEstr)
      If ScriptInterrotto Then Exit For
   Next
   ReDim aV(90)
   For k = 1 To 90
      aV(k) = "Num " & k
   Next
   Call InitTabella(aV)
   ReDim aV(90)
   For e = 1 To 90
      aV(e) = aPresenze(e)
   Next

End Sub

 

[solare]

Ciao Lotto tom75, grazie della risposta
Quello che chiedo io è diverso.
Vedi esempio nella richiesta del listato

 

[lotto_tom75]

Ciao Lotto tom75, grazie della risposta
Quello che chiedo io è diverso.
Vedi esempio nella richiesta del listato

Purtroppo non riesco a capire...
Spero che ilegend o chi per lui ce la faccia

 

[i legend]

Tom , bel lavoro, il tuo script può aiutare a cercare i numeri dopo la sortita.
x solare praticamente da quello che ho capito è identico all altro script ma anziche un numero cerca un ambo.
è lo stesso identico script, con una piccola modifica nel ciclo for dei numeri e nel titolo per adattare gli apszi
si possono scegliere quante estrazioni indietro andare , anche in quello vecchio , ma senza la mascherina

lo script elabora tutti gli ambi, anzichè lanciare tante volte lo script si lancia una volta e poi si vanno a vedere gli ambi desiderati

se si vogliono filtrare basta fare copia incolla e portarli su un foglio di calcolo, oppure scrollare
ecco lo script, fatto come ho capito la richiesta
se ci sono errori statistici vediamo di correggerli

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 modificato per richiesta ambo
'https://forum.lottoced.com/threads/richiesta-listato-x-i-legend-o-chi-ha-capacit%C3%A0.2207229/
' 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,N1,I,p,aSep,c
    Dim idestr,aR(1),aN(2)
    Dim Fin:Fin = EstrazioneFin
    Dim aV:aV = Array(1,2,3,4,5,6,7,8,9,10)
    Dim qEstr:qEstr = ScegliOpzioneMenu(aV,0,"NEstrazioni a ritroso") + 1' 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(255,0,0)
        aBold(aU_Estr(N)) = 1
    Next
    '
    '
    '
    ' imposto il titolo del lavoro
  
  
    Scrivi   " Ruota Spia |Data Spiata|    Cinquina    |",1,0,RGB(85,89,110),5
    Scrivi "idestr |AmboSpy|Rit.Cro|",1,0,RGB(0,128,128),5
    For N = 1 To qEstr
        Scrivi "IdEstr-" & Format2(N) & "|  Cinquina" & Format2(N) & "  |",1,0,RGB(0,128,192),5
    Next
    Scrivi
    For N = 1 To 89
        For N1 = N + 1 To 90
            aN(1) = N
            aN(2) = N1
            idestr = SerieUltima(1,Fin,aN,aR,2)
            Scrivi FormatSpace(" "&NomeRuota(aR(1)),12)&"|"& DataEstrazione(Fin)&" | "&StringaEstratti(Fin ,aR(1))&" ",1,0,RGB(235,235,250)
            Scrivi "|",,0
            Scrivi  " "&FormatSpace(idestr,5,1) & " |",1,0,RGB(230,255,230),RGB(0,147,0)

            Scrivi " "&StringaNumeri(aN,,True)& " " ,1,0,RGB(253,214,208),vbRed
            Scrivi  "| " & FormatSpace(Fin - idestr,5)&" ",1,0,RGB(230,255,230),RGB(0,147,0)
             Scrivi "|",1,0,,RGB(0,94,47)
            For I = 1 To qEstr
                Scrivi FormatSpace(idestr - I,9,1) & "|",,0
                ReDim aE(0): Call GetArrayNumeriRuota(idestr - I,aR(1),aE)
                If UBound(aE)>0 Then
                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
                Else
                Scrivi "00.00.00.00.00|",,0,vbRed
                End If
            Next
            Scrivi
            c = c + 1
            Call AvanzamentoElab(1,4005,c)
            If ScriptInterrotto Then Exit For
            DoEventsEx
        Next
        If ScriptInterrotto Then Exit For
    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

 

[solare]

Ciao I legend, come sempre hai centrato in pieno
Grazie infiniteeeee

 

[Sakti]

i legend, come sempre inpeccabile, ma si potrebbero evidenziare gli estratti che si ripetono almeno un paio di volte nelle successive estrazioni dalla sortita dell'ambo, penso sarebbe un ottimo suggerimento per le giocate successive..
Non volermene... ;-)

 

[i legend]

Ciao
solare, di nulla.
in effetti non è stato indolore fare le modifiche. Soprattutto ripensare l output.

Ciao ,Toon ,al momento , ho altri impegni.
Grazie per il pollicione

 

[solare]

Ciao I legend, ho riscontrato un problema, cerco di descriverlo.
In pratica se guardi le decine sia a Bari che cagliari la il numero 42 anzichè partire con 42-1,42-2 ecc ecc
inizia con 42-43.

 

[i legend]

Ciao , solare posta un immagine per favore, non riesco a capire cosa sono 42.1 ,42.2, 42.43
Posta il pezzo d immagine a cui fai riferimento.
In ogni caso
L ambo 42.1 è l ambo 1.42
Sono in ordine crescente.

Come ho scritto, vengono calcolati tutti gli ambi poi basta scrollare per trovare quello che ti serve.
Anziché lanciare 10 volte lo script per cercare 10 ambi ,lo lanci una volta sola e utilizzi quello che ti serve.
Se ho capito bene quello cui fai riferimento.

 

[solare]

Eccola

 

[i legend]

Si è come ho scritto sopra. Non devi cercare 42.1
ma 1.42

 

[solare]

OK Grazie