chi può aiutarmi per uno script

[sesto1]

per prima cosa un saluto a tutto il forum credo che mi troverò bene insieme a tutti voi, sono nuovo al mio primo post qui ce gente molto in gamba e preparata in tutti i sensi riguarda questo bel gioco del lotto,

ecco avrei bisogno di uno script per spaziometria purtroppo per me e arabo visto anche che ho una certa età e spero ci sia qualcuno che mi possa dare una mano,questo script dovrebbe avere queste caratteristiche

trovare in cicli di 18 estrazioni su 2 ruote a piacere in qualsiasi estrazione,dovrebbe trovate i numeri uguali usciti in entrambe le ruote in ogni ciclo impostato,vedo di fare un esempio reale

ruote PA-RO
Ciclo di 18 estrazioni dal 11/3/2021 a ritroso al 30/1/2021

i numeri usciti su entrambe le ruote

4-5-7-9-10-11-13-17-18-21-23-26-27-34-39-4143-49

54-56-60-63-64-67-68-69-74-77-79-82-83-86-87-89-90
questa e la più importante indispensabile





e poi se possibile ( ma non indispensabile) un'altra opzione di poter inserire i numeri manualmente a piacere sempre su un ciclo di 18 estrazioni

ecco e tutto spero di essermi espresso bene ,se no per eventuali domande sono qui,ancora ora ringrazio anticipatamente chi vorrà cimentarsi

in questo script sempre se e possibile

ringrazio di nuovo e auguro a tutti una buona seratae un buon fine settimana

sesto1

 

[joe]

Ciao Sisto, benvenuto,

Ho riassunto quanto hai chiesto.

Naturalmente lo script così com'è è bloccato alle indicazioni che hai fornito

Si tratterebbe di aggiungere cosa manca per completarlo.

Option Explicit
Sub Main
  Dim Ini,Fin,Es,I,P,S
  Dim Ru(2),L(90),M(90)
  Ini = EstrazioneFin - 17
  Fin = EstrazioneFin
  Ru(1) = PA_ : Ru(2) = RO_
  Scrivi "Dal " & DataEstrazione(Ini,,,"/") & " al "  & DataEstrazione(Fin,,,"/"),True
  Scrivi
  For Es = Ini To Fin
    For P = 1 To 5
      L(Estratto(Es,Ru(1),P)) = True
      M(Estratto(Es,Ru(2),P)) = True
    Next
  Next
  For I = 1 To 90
    If L(I) = True And M(I) = True Then
      S = S & "-" & Format2(I)
    End If
  Next
  Scrivi SiglaRuota (Ru(1)) & "-" & SiglaRuota(Ru(2)) & Space(1) & Right(S,Len(S) - 1)
End Sub

Joe

 

[sesto1]

grazie joe per il benvenuto e per la risposta

ok ho visto il risultato che da lo script e ok, ora però si deve poter operare per tutte le ruote a piacimento sia su una ruota che su due ruote qualsiasi,su cilcli di 18 estrazioni e poter partire da qualunque estrazione,es tu gli dai l'imput da tot estrazione a tot estrazione,poi gli indichi le ruote a piacere che sia una due e deve trovare i numeri uguali usciti in tutte e due le ruote scelte

 

[joe]

Ciao lo script (come quasi tutti i miei script) legge quale è l'ultima estrazione,

e da questa va indietro di 18 estrazioni.

Dunque agendo sul limite dell'archivio ... già lo fa.

Ma si può gestire la cosa diversamente.

Posso anche far calcolare tutte le coppie di ruote senza nessun input,

Oppure selezionarne 2 con 1 o 2 input.

E' tutto semplice.

Un pochino più complicato è ... se i cicli sono più di uno.

Questo no sono ancora riuscito a ricavarlo da quanto hai scritto.

In questo caso però sarebbe meglio avere solo le 2 ruote scelte.

Soprattutto per non complicare troppo l'output.

 

[sesto1]

aspita sei velocissimo non riesco a starti dietro azz.. l'età va be comunque

allora poter selezionare le ruote sarebbe ottimo ,i cicli vanno bene così un solo ciclo da 18 per volta non ci sono problemi va bene,
fare 1 ciclo per volta e selzionare le ruote a scelta e ottimo,io sono nuovo dl forum come fai a mettere le faccine

 

[joe]

Per le faccine ne uso sempre solo una che immetto da tastiera con due punti : seguiti da parentesi chiusa )

Lo script è semplice ed è più veloce del tempo che si perde ad inserire le 2 ruote

dunque ho preferito farle calcolare tutte perciò basta prendere la riga che interessa.

Option Explicit
Sub Main
   Dim Ini,Fin,Es,I,P,S
   Dim A,B
   Ini = EstrazioneFin - 17
   Fin = EstrazioneFin
   Scrivi "Dal " & DataEstrazione(Ini,,,"/") & " al " & DataEstrazione(Fin,,,"/"),True
   Scrivi
   For A = 1 To 10
      For B = A + 1 To 12: If B = 11then B = 12
         ReDim L(90),M(90) : S= ""
         For Es = Ini To Fin
            For P = 1 To 5
               L(Estratto(Es,A,P)) = True
               M(Estratto(Es,B,P)) = True
            Next
         Next
         For I = 1 To 90
            If L(I) = True And M(I) = True Then
               S = S & "-" & Format2(I)
            End If
         Next
         Scrivi SiglaRuota(A) & "-" & SiglaRuota(B) & Space(1) & Right(S,Len(S) - 1)
      Next
   Next
End Sub

 

[sesto1]

-
Buongiorno e buona domenica joe e tutto il forum

ho provato il listato va tutto ok fa la ricerca che volevo ,ti ringrazio per la velocità e competenza,volevo solo chiederti se e possibile abbinarci la seconda opzione che dicevo che non era indispensabile,oppure se puoi(lo so che ti sto chiedendo troppo,ma se non e possibile fa lo stesso)e cioè un'altra opzione di poter inserire i numeri manualmente a piacere sempre su un ciclo di 18 estrazioni
ma stavolta con opzione di una o 2 ruote a piacere e non tutte insieme,es:

voglio vedere sempre in un ciclo di 18 estrazioni ,metto una quantità" tot" di numeri (che metto a caso ora giusto per fare l'esempio)

2-5-6-8-10-16-15-16-18-21-25-28-32-45-47-48-49-50-52-54-55-56-57-60-
62-64-66-67-68-70-71-73-75-77-78-80-81-83-84-86-88-89-90

voglio vedere quali di questi numeri sono usciti su BA-VE, però sempre su entrambe le ruote,scusami se ti disturbo ancora

ripeto se non e possibile va bene lo stesso, comunque ti ringrazio molto ancora

buona giornata

sesto1
-

 

[i legend]

Ciao Cinzia
Appena finito si pranzare provo a lanciare lo script👍

 

[Cinzia27]

Ilegend, io sono qua
Listato coppie di ambi mai usciti contemporaneamente su tutte

 

[i legend]

Ilegend, io sono qua
Listato coppie di ambi mai usciti contemporaneamente su tutte

🤣🤣🤣🤣🤣🤣
Scusa quando ho risposto devo aver aperto un altro 3d
Chiedo scusa per l invasione off topic

 

[joe]

Buon Giorno a tutte/i.

Questo selettore ti va bene ?

Sub Main
   Dim aNum
   Dim nSel
   nSel = ScegliNumeri(aNum)
   Call Scrivi(StringaNumeri(aNum,,True))
End Sub

 

[sesto1]

.)
Buon pomeriggio a tutti e buon inizio settimana

Ciao joe questo selettore e perfetto proprio quello che ci vuole per accorciare ore di ricerche visive e per me che vedo anche male e un autentica manna se si può mettere nello script di prima, non so proprio come ringraziarti sei bravissimo
buona serata

sesto1

 

[joe]

Ti ringrazio per i complimenti,

ma quel selettore è merito di LuigiB autore di Spaziometria.

Io, ne sto solo facendo uso.

La nuova versione del programma lo integra.

Affinchè lo scipt, funzioni come prima devi premere il bottone "INV SEL"

e così sono ammessi (in condizione logica AND) tutti i 90 numeri.

Altrimenti con il selettore scegli quelli che desideri controllare da 1 a 90,

e ... lo script ti trova quelli tra essi presenti nelle 2 ruote.

Option Explicit
Sub Main
'Script By Joe V.3.0 del 15/03/2021
'Selettrore & numeri presenti in coppie di ruote (nel ritardo naturale)
   Dim Ini,Fin,Es,I,P,S
   Dim A,B
   Dim aNum
   Dim nSel
   Dim K
   nSel = ScegliNumeri(aNum)
   Call Scrivi("Filtro : " & StringaNumeri(aNum,,True) & Chr(13),True)
   Ini = EstrazioneFin - 17
   Fin = EstrazioneFin
   Scrivi "Dal " & DataEstrazione(Ini,,,"/") & " al " & DataEstrazione(Fin,,,"/"),True
   Scrivi
   For A = 1 To 10
      For B = A + 1 To 12 : If B = 11 Then B = 12
         ReDim L(90),M(90) : S = ""
         For Es = Ini To Fin
            For P = 1 To 5
               L(Estratto(Es,A,P)) = True
               M(Estratto(Es,B,P)) = True
            Next
         Next
         For I = 1 To 90
            If L(I) = True And M(I) = True Then
               For K = 1 To nSel
                  If aNum(K) = I Then
                     S = S & "-" & Format2(I)
                  End If
               Next
            End If
         Next
         If Len(S) = 0 Then S = Space(2) & "-"
         Scrivi SiglaRuota(A) & "-" & SiglaRuota(B) & Space(1) & Right(S,Len(S) - 1)
      Next
      Scrivi
   Next
End Sub

 

[sesto1]

Ciao joe

ho provato tutto ok,ti ringrazio molto in sieme a LuigiB che ha fatto questo bel programma
ringrazio di nuovo

buona giornata a tutti

sesto1