Novità

Chiedo gentilmente uno script

U

Ufrenk

Super Member >PLATINUM<
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
    sabato 06 settembre 2025
    Bari
    01
    26
    50
    16
    49
    Cagliari
    61
    18
    01
    62
    22
    Firenze
    84
    23
    32
    26
    88
    Genova
    24
    27
    47
    76
    44
    Milano
    59
    08
    06
    11
    39
    Napoli
    02
    65
    40
    28
    57
    Palermo
    09
    66
    51
    81
    49
    Roma
    76
    55
    73
    88
    65
    Torino
    38
    49
    40
    21
    90
    Venezia
    80
    60
    34
    69
    42
    Nazionale
    89
    76
    64
    80
    21
    Estrazione Simbolotto
    Palermo
    39
    34
    02
    08
    43
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto