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
    sabato 04 gennaio 2025
    Bari
    48
    55
    67
    87
    14
    Cagliari
    60
    78
    37
    36
    07
    Firenze
    04
    55
    45
    27
    42
    Genova
    46
    77
    47
    17
    33
    Milano
    17
    86
    14
    63
    55
    Napoli
    25
    71
    16
    48
    28
    Palermo
    65
    55
    31
    05
    25
    Roma
    80
    05
    74
    75
    28
    Torino
    28
    66
    20
    24
    87
    Venezia
    25
    29
    20
    70
    24
    Nazionale
    62
    71
    03
    28
    15
    Estrazione Simbolotto
    Bari
    42
    33
    18
    36
    32
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto