Chiedo gentilmente uno script

[Ufrenk]

Buongiorno a tutti
mi affido a chi e' esperto in script ,io non ne sono capace.
Mi farebbe comodo uno script che:
1) possa inserire 3 numeri a mia scelta
2) possa verificare esito di ambo e terno su tutte le ruote ( e magari su ogni ruota che e' o sono sortiti)
3) mi rilasci una lista che in ordine cronologico mi faccia vedere gli esiti
4) la ricerca non ho bisogno che parta dal lontano 1871,mi basterebbe che sia fatta negli ultimi 5 anni
non so se sono stato chiaro
Ringrazio vivamente chi riesca a farlo

 

[Pandit]

Se Ti va bene, qui puoi scegliere Numeri, estrazioni, colpi di gioco e Ruote..

Anticipazione (Spoiler)

Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri
nr = UBound
Scrivi "Numeri Richiesti : ",1
Scrivi StringaNumeri(n,".") & " Tot.n." & qn,1,2,4
x = CInt(InputBox("Quante estrazioni d'analisi?",,700))'
x1 = CInt(InputBox("Quanti colpi di gioco?",,12))
ReDim aRuote(11),rt(12)
If ScegliRuote(aRuote) > 0 Then
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
kn = kn + 1
rt(kn) = aRuote(k)
End If
'Metodo Ricerca proposto da Ufrenk --------
posta(2) = 1
posta(3) = 0.5
'posta(4) = 0.5
ini = EstrazioneFin - x
fin = EstrazioneFin
co = 0
k = x1
For es = ini To fin
Messaggio es
Call AvanzamentoElab(ini,fin,es)
ImpostaGiocata 1,n,aRuote,posta,k',2
Gioca es,1
Scrivi String(100,"-") : ColoreTesto 1
Next
Next
End If
ColoreTesto 1
Scrivi " by Pandit"
ScriviResoconto
End Sub

 

[Ufrenk]

Ciao Pandit
ti ringrazio di cuore,funziona bene ,l'unico inconveniente per me e' che spaziometria ora non mi aggiorna piu' le estrazioni fino all'ultima ma fino a luglio,non so come fare ,ho provato anche via web ma e' peggio che andare di notte

 

[Missione Impossibile2]

Se Ti va bene, qui puoi scegliere Numeri, estrazioni, colpi di gioco e Ruote..

Anticipazione (Spoiler)

Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri
nr = UBound
Scrivi "Numeri Richiesti : ",1
Scrivi StringaNumeri(n,".") & " Tot.n." & qn,1,2,4
x = CInt(InputBox("Quante estrazioni d'analisi?",,700))'
x1 = CInt(InputBox("Quanti colpi di gioco?",,12))
ReDim aRuote(11),rt(12)
If ScegliRuote(aRuote) > 0 Then
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
kn = kn + 1
rt(kn) = aRuote(k)
End If
'Metodo Ricerca proposto da Ufrenk --------
posta(2) = 1
posta(3) = 0.5
'posta(4) = 0.5
ini = EstrazioneFin - x
fin = EstrazioneFin
co = 0
k = x1
For es = ini To fin
Messaggio es
Call AvanzamentoElab(ini,fin,es)
ImpostaGiocata 1,n,aRuote,posta,k',2
Gioca es,1
Scrivi String(100,"-") : ColoreTesto 1
Next
Next
End If
ColoreTesto 1
Scrivi " by Pandit"
ScriviResoconto
End Sub

Ciao Pandit
Riesci a farmelo solo mensile per il 1° del mese, senza ambi e terni e tutte le scelte le faccio io.Grazie

 

[Pandit]

Prova questo, poi cerca nel forum, trovi certamente spiegazioni come aggiornare megli,
è uno script del Grande Joe e Funziona bene...:

Anticipazione (Spoiler)

Option Explicit
Sub Main
'Agg_Silop V.3.2 del 02/05/2023
'Script per Spaziometria By Joe.
Dim sFileLoc
Dim nEstrTot,sDataLastEstr,k,r,e
Dim sDataEstr,nNumEstr,nSalvate
Dim b
Dim sFileBd
Dim sLink
Dim Ia,N,sVV,x
Dim CfrData
sLink = "https://www.silop.it/Archivio(televideo)/Archivio.txt"
b = False : N = False
nSalvate = 0
sFileBd = GetDirectoryAppData & "BaseDati.dat"
sFileLoc = GetDirectoryAppData & "ArcTlv\"
Messaggio "Script By Joe"
If CreaDirectory(sFileLoc) Then
sFileLoc = sFileLoc & "Archivio.txt"
If DownloadFromWeb(sLink,sFileLoc) Then
nEstrTot = EstrazioniArchivio
sDataLastEstr = DataEstrazione(nEstrTot,,,"/")
Ia = IndiceAnnuale(nEstrTot)
ReDim aRighe(0)
Call LeggiRigheFileDiTesto(sFileLoc,aRighe)
For k = 1 To UBound(aRighe)
AvanzamentoElab 1,UBound(aRighe),k
ReDim aV(0)
If Len(aRighe(k)) = 118 Then
sDataEstr = Left(aRighe(k),2) & "/" & Mid(aRighe(k),3,2) & "/" & Mid(aRighe(k),5,4)
sVV = Right(aRighe(k),110)
If b Then
If N = False And(Right(sDataEstr,4) <> Right(sDataLastEstr,4)) Then Ia = 0 : N = True
If Left(sDataEstr,4) <> Left(sDataLastEstr,4) Then
Ia = Ia + 1
nNumEstr =(Ia)
If nNumEstr > 0 And IsDate(sDataEstr) Then
ReDim aEstr(11,5)
r = 1 : e = 0
For x = 1 To 110 Step 2
e = e + 1
aEstr(r,e) = Mid(sVV,x,2)
If e = 5 Then r = r + 1 : e = 0
Next
If CfrData <> Left(sDataEstr,5) Then
If SalvaEstrazione(aEstr,sDataEstr,nNumEstr,sFileBd) Then
CfrData = Left(sDataEstr,5)
nSalvate = nSalvate + 1
End If
Else
ColoreTesto 2
Scrivi "ATTENZIONE " & sDataEstr & " ERRORE NELLE DATE",True
ColoreTesto 0
End If
End If
End If
End If
If sDataEstr = sDataLastEstr Then b = True
End If
Next
If nSalvate > 0 Then AllineaArchivi
Else
MsgBox "Errore download verificare il link con il browser"
End If
Call Scrivi("Sono state aggiunte " & nSalvate & " estrazioni")
Call Scrivi("")
Call Scrivi("Estrazioni totali " & QuantitaEstrazioniInFile(sFileBd))
Call Scrivi("")
Call Scrivi("Sito Archivio " & Left(sLink,20))
Call Scrivi("")
End If
Call Scrivi("Tempo Trascorso " & TempoTrascorso)
End Sub

 

[Pandit]

Missione 2, non ho ben capito se vuoi una tabella o una ricerca mirata diversa, guarda se così Ti può andare, ho aggiunto la scelta dell'estrazione mensile, ma lasciado la ricerca per ambo e terno...

Anticipazione (Spoiler)

Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri
nr = UBound
Scrivi "Numeri Richiesti : ",1
Scrivi StringaNumeri(n,".") & " Tot.n." & qn,1,2,4
x = CInt(InputBox("Quante estrazioni d'analisi?",,700))'
x1 = CInt(InputBox("Quanti colpi di gioco?",,12))
x2 = CInt(InputBox("Quale Estrazione Mensile?",,1))
ReDim aRuote(11),rt(12)
If ScegliRuote(aRuote) > 0 Then
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
kn = kn + 1
rt(kn) = aRuote(k)
End If
posta(2) = 1
posta(3) = 0.5
ini = EstrazioneFin - x
fin = EstrazioneFin
co = 0
k = x1
For es = ini To fin
Messaggio es
Call AvanzamentoElab(ini,fin,es)
If IndiceMensile(es) = x2 Then
ImpostaGiocata 1,n,aRuote,posta,k',2
Gioca es,1
Scrivi String(100,"-") : ColoreTesto 1
End If
Next
Next
End If
ColoreTesto 1
Scrivi " by Pandit"
ScriviResoconto
End Sub

Tabella Rapida se può andare bene...

Anticipazione (Spoiler)

Sub Main
Dim ini,fin,nr
ReDim n(90)
Call ScegliNumeri
nr = UBound
Scrivi "Numeri Richiesti : ",1
Scrivi StringaNumeri(n,".") & " Tot.n." & qn,1,2,4
x = CInt(InputBox("Quante estrazioni d'analisi?",,700))'
x1 = CInt(InputBox("Quanti colpi di gioco?",,12))
x2 = CInt(InputBox("Quale Estrazione Mensile?",,1))
ReDim aRuote(11),rt(12)
If ScegliRuote(aRuote) > 0 Then
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
kn = kn + 1
rt(kn) = aRuote(k)
End If
ini = EstrazioneFin - x
fin = EstrazioneFin
T = Array(T,"Estrazione"," Ruote "," Numeri in Gioco","Verifica Risultati","Colpo")
Call InitTabella(T,RGB(0,71,171),,3,6,"Times")
For es = ini To fin
If IndiceMensile(es) = x2 Then
Call VerificaEsito(n,aRuote,es + 1,1,x1,,esito,clp,esA,id)
T = Array(T,GetInfoEstrazione(es),StringaRuote(aRuote),StringaNumeri,esA,clp)
Call AddRigaTabella(T)
Call SetColoreCella(1,RGB(205,201,201),RGB(0,0,0))
Call SetColoreCella(2,RGB(255,255,0),RGB(0,0,0))
Call SetColoreCella(3,RGB(255,0,0),RGB(0,0,0))
Call SetColoreCella(4,RGB(0,255,0),RGB(0,0,0))
Call SetColoreCella(5,RGB(190,190,190),RGB(0,0,0))
Call SetColoreCella(6,RGB(255,255,0),RGB(0,0,0))
End If
Next
Next
End If
CreaTabella
ColoreTesto 1
Scrivi " by Pandit"
End Sub

 

[Missione Impossibile2]

Missione 2, non ho ben capito se vuoi una tabella o una ricerca mirata diversa, guarda se così Ti può andare, ho aggiunto la scelta dell'estrazione mensile, ma lasciado la ricerca per ambo e terno...

Anticipazione (Spoiler)

Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri
nr = UBound
Scrivi "Numeri Richiesti : ",1
Scrivi StringaNumeri(n,".") & " Tot.n." & qn,1,2,4
x = CInt(InputBox("Quante estrazioni d'analisi?",,700))'
x1 = CInt(InputBox("Quanti colpi di gioco?",,12))
x2 = CInt(InputBox("Quale Estrazione Mensile?",,1))
ReDim aRuote(11),rt(12)
If ScegliRuote(aRuote) > 0 Then
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
kn = kn + 1
rt(kn) = aRuote(k)
End If
posta(2) = 1
posta(3) = 0.5
ini = EstrazioneFin - x
fin = EstrazioneFin
co = 0
k = x1
For es = ini To fin
Messaggio es
Call AvanzamentoElab(ini,fin,es)
If IndiceMensile(es) = x2 Then
ImpostaGiocata 1,n,aRuote,posta,k',2
Gioca es,1
Scrivi String(100,"-") : ColoreTesto 1
End If
Next
Next
End If
ColoreTesto 1
Scrivi " by Pandit"
ScriviResoconto
End Sub

Tabella Rapida se può andare bene...

Anticipazione (Spoiler)

Sub Main
Dim ini,fin,nr
ReDim n(90)
Call ScegliNumeri
nr = UBound
Scrivi "Numeri Richiesti : ",1
Scrivi StringaNumeri(n,".") & " Tot.n." & qn,1,2,4
x = CInt(InputBox("Quante estrazioni d'analisi?",,700))'
x1 = CInt(InputBox("Quanti colpi di gioco?",,12))
x2 = CInt(InputBox("Quale Estrazione Mensile?",,1))
ReDim aRuote(11),rt(12)
If ScegliRuote(aRuote) > 0 Then
For k = 1 To UBound(aRuote)
If aRuote(k) > 0 Then
kn = kn + 1
rt(kn) = aRuote(k)
End If
ini = EstrazioneFin - x
fin = EstrazioneFin
T = Array(T,"Estrazione"," Ruote "," Numeri in Gioco","Verifica Risultati","Colpo")
Call InitTabella(T,RGB(0,71,171),,3,6,"Times")
For es = ini To fin
If IndiceMensile(es) = x2 Then
Call VerificaEsito(n,aRuote,es + 1,1,x1,,esito,clp,esA,id)
T = Array(T,GetInfoEstrazione(es),StringaRuote(aRuote),StringaNumeri,esA,clp)
Call AddRigaTabella(T)
Call SetColoreCella(1,RGB(205,201,201),RGB(0,0,0))
Call SetColoreCella(2,RGB(255,255,0),RGB(0,0,0))
Call SetColoreCella(3,RGB(255,0,0),RGB(0,0,0))
Call SetColoreCella(4,RGB(0,255,0),RGB(0,0,0))
Call SetColoreCella(5,RGB(190,190,190),RGB(0,0,0))
Call SetColoreCella(6,RGB(255,255,0),RGB(0,0,0))
End If
Next
Next
End If
CreaTabella
ColoreTesto 1
Scrivi " by Pandit"
End Sub

Grazie Pandit,questa e' quello che fa per me