Novità

Chiedo gentilmente uno script

U

Ufrenk

Super Member >GOLD<
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
 
Ultima modifica:
Se Ti va bene, qui puoi scegliere Numeri, estrazioni, colpi di gioco e Ruote..
Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri(n)
nr = UBound(n)
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
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
 
Pandit ha scritto:
Se Ti va bene, qui puoi scegliere Numeri, estrazioni, colpi di gioco e Ruote..
Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri(n)
nr = UBound(n)
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
Clicca per espandere...
Ciao Pandit
Riesci a farmelo solo mensile per il 1° del mese, senza ambi e terni e tutte le scelte le faccio io.Grazie
 
Prova questo, poi cerca nel forum, trovi certamente spiegazioni come aggiornare megli,
è uno script del Grande Joe e Funziona bene...:
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
 
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...
Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri(n)
nr = UBound(n)
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...

Sub Main
Dim ini,fin,nr
ReDim n(90)
Call ScegliNumeri(n)
nr = UBound(n)
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(n),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
 
Ultima modifica:
Pandit ha scritto:
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...
Sub Main
Dim posta(5),ini,fin,n1(6),nr
ReDim n(90)
Call ScegliNumeri(n)
nr = UBound(n)
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...

Sub Main
Dim ini,fin,nr
ReDim n(90)
Call ScegliNumeri(n)
nr = UBound(n)
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(n),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
Clicca per espandere...
Grazie Pandit,questa e' quello che fa per me
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    venerdì 11 luglio 2025
    Bari
    39
    28
    27
    01
    80
    Cagliari
    54
    79
    69
    43
    61
    Firenze
    62
    60
    86
    80
    05
    Genova
    45
    10
    42
    79
    84
    Milano
    28
    59
    23
    46
    11
    Napoli
    01
    55
    52
    50
    39
    Palermo
    75
    17
    74
    82
    54
    Roma
    38
    13
    79
    25
    44
    Torino
    68
    29
    26
    40
    06
    Venezia
    46
    84
    64
    27
    67
    Nazionale
    72
    77
    46
    61
    23
    Estrazione Simbolotto
    Nazionale
    12
    34
    36
    10
    39
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto