richiesta script 1 e 2 ...

TIGERSUITE · 1 Marzo 2020

N° 1
Per favore chiedo agli esperti , si può avere uno script dove ti chiede che numero deve cercare e quando lo trova

te li evidenzia isotopi come da foto ?

richiesta listato per possizionato isotopo.JPG

////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////////

N° 2
E' possibile avere uno script che ti elenca posizione per posizione di un determinato numero ?
Esempio voglio sapere il 56 a Napoli in 1 - 2 - 3 - 4 - 5 poszione il suo ritardo attuale ?

grazie anticipatamente

i legend · 2 Marzo 2020

Ciao se cerchi ho postato il secondo script qualche tempo fa per l utente Paolo.
Ciao.
Il primo script è semplice , prova a spiegare quante estrazioni . Se ne servono tante bisogna inserirle in una rabella

i legend · 2 Marzo 2020

Tabella.

i legend · 2 Marzo 2020

Codice:

Option Explicit
' script per Paolo utente su forum LottoCed
' lo script non restituisce previsioni, controllare  da altre fonti se i dati in output siano esatti
' gli errori sono sempre possibili
' lo script è dato gratuitamente nessuno puo venderlo o cederlo chiedendo una donazione in cambio
Sub Main
   ' dichiaro le variabili di impostazione ricerca  da utilizzare
   Dim Ini,Fin,bRet,aComb,nClasse
   ReDim aRu(0)
   'Verifico che i parametri inseriti siano corretti
   aComb = Array("Estratto","Coppia")
   bRet = False
   If MsgBox("Non si garantisce la correttezza dei dati Riportati " & vbCrLf & "Vuoi continuare ugualmente ?",_
      32 + 4,"Script Statistico per estratto o coppia nelle 5 posizioni") = vbYes Then
      If ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin) Then
         Call ScegliRuote(aRu)
         If UBound(aRu) Then
            nClasse = ScegliOpzioneMenu(aComb,0,"Classe da Sviluppare") + 1
            If nClasse Then
               bRet = True
            Else
               Call MsgBox("Non hai inserito alcuna Classe",vbYes,"Wrong Message")
            End If
         Else
            Call MsgBox("Non hai inserito alcuna ruota",vbYes,"Wrong Message")
         End If
      Else
         Call MsgBox("Il range Estrazioni inserito non è valido",vbYes,"Wrong Message")
      End If
   Else
      Exit Sub
   End If
   If bRet = False Then Exit Sub
   ' dichiaro le altre variabili utili alla ricerca
   ReDim aNum(90)
   Dim N,p,C,Rit,RitMax,Freq,SumRit,SumFreq,idSvi
   Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
   Dim aRit(5),aRitMax(5),aFreq(5),aPos(1)
   For N = 1 To 90
      aNum(N) = N
   Next
   Dim colT:colT = InitSviluppoIntegrale(aNum,nClasse)
   Dim aTit:aTit = Array(0,"IdComb","Formazione","FrP1","FrP2","FrP3","FrP4","FrP5","SumFre","FreqMin","FreqMax","RcP1","RcP2","RcP3","RcP4","RcP5","SumRit","RitMin","RitMax","RsP1","RsP2","RsP3","RsP4","RsP5","RstMin","RstMax")
   Call InitTabella(aTit)
   idSvi = 0
   Do While GetCombSviluppo(aNum)
      If ScriptInterrotto Then Exit Do
      idSvi = idSvi + 1
      Call AvanzamentoElab(1,colT,idSvi)
      SumRit = 0
      SumFreq = 0
      For p = 1 To 5
         aPos(1) = p
         Call StatisticaFormazioneTurbo(aNum,aRu,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
         aRit(p) = Rit
         aRitMax(p) = RitMax
         aFreq(p) = Freq
         SumRit = SumRit + Rit
         SumFreq = SumFreq + Freq
      Next
      RcMin = MinimoV(aRit,1,5)
      RcMax = MassimoV(aRit)
      FreqMin = MinimoV(aFreq,1,5)
      RstoMax = MassimoV(aRitMax)
      RstoMin = MinimoV(aRitMax,1,5)
      FreqMax = MassimoV(aFreq)
      Dim atab
      atab = Array(0,idSvi,StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
      aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
      Call AddRigaTabella(atab,RGB(240,240,255))
      ' imposto la formattazione delle celle
      Call SetColoreCella(1,RGB(240,240,240),RGB(128,0,0))
      Call SetColoreCella(2,RGB(255,255,255),RGB(20,68,107))
      For C = 3 To 7
         If atab(C) = atab(9) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(10) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(8,vbWhite,RGB(0,100,0))
      Call SetColoreCella(9,vbWhite,RGB(255,0,0))
      Call SetColoreCella(10,vbWhite,RGB(0,73,147))
      For C = 11 To 15
         If atab(C) = atab(17) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(18) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(16,vbWhite,RGB(0,100,0))
      Call SetColoreCella(17,vbWhite,RGB(255,0,0))
      Call SetColoreCella(18,vbWhite,RGB(0,73,147))
      For C = 19 To 23
         If atab(C) = atab(24) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(25) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(24,vbWhite,RGB(255,0,0))
      Call SetColoreCella(25,vbWhite,RGB(0,73,147))
   Loop
   If ScriptInterrotto Then
      Scrivi "Lo script è stato interrotto"
      Exit Sub
   End If
   ' scrivo i parametri di ricerca
   Dim sRic
   If nClasse = 1 Then sRic = "un Estratto":Else sRic = "una Coppia per estratto"
   Scrivi FormatSpace("  Analisi Ritardi e Frequenze di " & sRic & "  nelle cinque posizioni",158),1,,RGB(240,240,240),RGB(100,100,100)
   Scrivi FormatSpace(" ",158),,,RGB(238,238,239),vbWhite
   Scrivi FormatSpace("  Data inizio Analisi:     " & DataEstrazione(Ini) & "    ( Conc: " & FormatSpace(Ini,5,1) & " )",158),1,,RGB(245,245,247),RGB(100,100,100)
   Scrivi FormatSpace("  Data fine Analisi:       " & DataEstrazione(Fin) & "    ( Conc: " & FormatSpace(Fin,5,1) & " )",158),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace("  Ruote analizzate:        " & StringaRuote(aRu),158),1,,RGB(247,247,249),RGB(100,100,100)
   Scrivi FormatSpace(" ",158),,,RGB(248,248,250)
   Scrivi
   Scrivi FormatSpace("  Legenda Colori utilizzati  ",158),1,,RGB(0,128,192),RGB(240,250,255)
   Scrivi
   Scrivi "    FreqMin,RitMin,RstoMin   ",1,,RGB(255,213,213),RGB(83,0,0)
   Scrivi
   Scrivi "    FreqMax,RitMax,RstoMax   ",1,,RGB(218,250,247)
      Scrivi
   Call SetTableWidth("1270 pxz")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile()
End Sub

Prova a vedere se l ho copiato correttamente ( sto usando il cellulare)e se funziona come vuoi tu.
Lo trovi al messaggio
"Variazione script di i legend"
richiesta dell utente paaoloo

TIGERSUITE · 2 Marzo 2020

i legend ha scritto:
Ciao se cerchi ho postato il secondo script qualche tempo fa per l utente Paolo.
Ciao.
Il primo script è semplice , prova a spiegare quante estrazioni . Se ne servono tante bisogna inserirle in una rabella

In una ventina di estrazioni come da foto va bene
grazie infinite

TIGERSUITE · 3 Marzo 2020

i legend ha scritto:

Codice:

Option Explicit
' script per Paolo utente su forum LottoCed
' lo script non restituisce previsioni, controllare  da altre fonti se i dati in output siano esatti
' gli errori sono sempre possibili
' lo script è dato gratuitamente nessuno puo venderlo o cederlo chiedendo una donazione in cambio
Sub Main
   ' dichiaro le variabili di impostazione ricerca  da utilizzare
   Dim Ini,Fin,bRet,aComb,nClasse
   ReDim aRu(0)
   'Verifico che i parametri inseriti siano corretti
   aComb = Array("Estratto","Coppia")
   bRet = False
   If MsgBox("Non si garantisce la correttezza dei dati Riportati " & vbCrLf & "Vuoi continuare ugualmente ?",_
      32 + 4,"Script Statistico per estratto o coppia nelle 5 posizioni") = vbYes Then
      If ScegliRange(Ini,Fin,EstrazioneIni,EstrazioneFin) Then
         Call ScegliRuote(aRu)
         If UBound(aRu) Then
            nClasse = ScegliOpzioneMenu(aComb,0,"Classe da Sviluppare") + 1
            If nClasse Then
               bRet = True
            Else
               Call MsgBox("Non hai inserito alcuna Classe",vbYes,"Wrong Message")
            End If
         Else
            Call MsgBox("Non hai inserito alcuna ruota",vbYes,"Wrong Message")
         End If
      Else
         Call MsgBox("Il range Estrazioni inserito non è valido",vbYes,"Wrong Message")
      End If
   Else
      Exit Sub
   End If
   If bRet = False Then Exit Sub
   ' dichiaro le altre variabili utili alla ricerca
   ReDim aNum(90)
   Dim N,p,C,Rit,RitMax,Freq,SumRit,SumFreq,idSvi
   Dim RcMax,RstoMin,RstoMax,FreqMax,FreqMin,RcMin
   Dim aRit(5),aRitMax(5),aFreq(5),aPos(1)
   For N = 1 To 90
      aNum(N) = N
   Next
   Dim colT:colT = InitSviluppoIntegrale(aNum,nClasse)
   Dim aTit:aTit = Array(0,"IdComb","Formazione","FrP1","FrP2","FrP3","FrP4","FrP5","SumFre","FreqMin","FreqMax","RcP1","RcP2","RcP3","RcP4","RcP5","SumRit","RitMin","RitMax","RsP1","RsP2","RsP3","RsP4","RsP5","RstMin","RstMax")
   Call InitTabella(aTit)
   idSvi = 0
   Do While GetCombSviluppo(aNum)
      If ScriptInterrotto Then Exit Do
      idSvi = idSvi + 1
      Call AvanzamentoElab(1,colT,idSvi)
      SumRit = 0
      SumFreq = 0
      For p = 1 To 5
         aPos(1) = p
         Call StatisticaFormazioneTurbo(aNum,aRu,1,Rit,RitMax,0,Freq,Ini,Fin,,aPos)
         aRit(p) = Rit
         aRitMax(p) = RitMax
         aFreq(p) = Freq
         SumRit = SumRit + Rit
         SumFreq = SumFreq + Freq
      Next
      RcMin = MinimoV(aRit,1,5)
      RcMax = MassimoV(aRit)
      FreqMin = MinimoV(aFreq,1,5)
      RstoMax = MassimoV(aRitMax)
      RstoMin = MinimoV(aRitMax,1,5)
      FreqMax = MassimoV(aFreq)
      Dim atab
      atab = Array(0,idSvi,StringaNumeri(aNum,,True),aFreq(1),aFreq(2),aFreq(3),aFreq(4),aFreq(5),SumFreq,FreqMin,FreqMax,_
      aRit(1),aRit(2),aRit(3),aRit(4),aRit(5),SumRit,RcMin,RcMax,aRitMax(1),aRitMax(2),aRitMax(3),aRitMax(4),aRitMax(5),RstoMin,RstoMax)
      Call AddRigaTabella(atab,RGB(240,240,255))
      ' imposto la formattazione delle celle
      Call SetColoreCella(1,RGB(240,240,240),RGB(128,0,0))
      Call SetColoreCella(2,RGB(255,255,255),RGB(20,68,107))
      For C = 3 To 7
         If atab(C) = atab(9) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(10) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(8,vbWhite,RGB(0,100,0))
      Call SetColoreCella(9,vbWhite,RGB(255,0,0))
      Call SetColoreCella(10,vbWhite,RGB(0,73,147))
      For C = 11 To 15
         If atab(C) = atab(17) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(18) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(16,vbWhite,RGB(0,100,0))
      Call SetColoreCella(17,vbWhite,RGB(255,0,0))
      Call SetColoreCella(18,vbWhite,RGB(0,73,147))
      For C = 19 To 23
         If atab(C) = atab(24) Then
            Call SetColoreCella(Int(C),RGB(255,213,213),RGB(83,0,0))
         ElseIf atab(C) = atab(25) Then
            Call SetColoreCella(Int(C),RGB(218,250,247),RGB(11,79,72))
         End If
      Next
      Call SetColoreCella(24,vbWhite,RGB(255,0,0))
      Call SetColoreCella(25,vbWhite,RGB(0,73,147))
   Loop
   If ScriptInterrotto Then
      Scrivi "Lo script è stato interrotto"
      Exit Sub
   End If
   ' scrivo i parametri di ricerca
   Dim sRic
   If nClasse = 1 Then sRic = "un Estratto":Else sRic = "una Coppia per estratto"
   Scrivi FormatSpace("  Analisi Ritardi e Frequenze di " & sRic & "  nelle cinque posizioni",158),1,,RGB(240,240,240),RGB(100,100,100)
   Scrivi FormatSpace(" ",158),,,RGB(238,238,239),vbWhite
   Scrivi FormatSpace("  Data inizio Analisi:     " & DataEstrazione(Ini) & "    ( Conc: " & FormatSpace(Ini,5,1) & " )",158),1,,RGB(245,245,247),RGB(100,100,100)
   Scrivi FormatSpace("  Data fine Analisi:       " & DataEstrazione(Fin) & "    ( Conc: " & FormatSpace(Fin,5,1) & " )",158),1,,RGB(246,246,248),RGB(100,100,100)
   Scrivi FormatSpace("  Ruote analizzate:        " & StringaRuote(aRu),158),1,,RGB(247,247,249),RGB(100,100,100)
   Scrivi FormatSpace(" ",158),,,RGB(248,248,250)
   Scrivi
   Scrivi FormatSpace("  Legenda Colori utilizzati  ",158),1,,RGB(0,128,192),RGB(240,250,255)
   Scrivi
   Scrivi "    FreqMin,RitMin,RstoMin   ",1,,RGB(255,213,213),RGB(83,0,0)
   Scrivi
   Scrivi "    FreqMax,RitMax,RstoMax   ",1,,RGB(218,250,247)
      Scrivi
   Call SetTableWidth("1270 pxz")
   Call SetTableHeight("286 pxz")
   Call CreaTabellaOrdinabile()
End Sub

Prova a vedere se l ho copiato correttamente ( sto usando il cellulare)e se funziona come vuoi tu.
Lo trovi al messaggio
"Variazione script di i legend"
richiesta dell utente paaoloo

funziona benissimo grazie!

i legend · 3 Marzo 2020

Prego. Oggi appena ho la possibilità ti posto il primo script come da tue indicazioni.
Ciao

joe · 3 Marzo 2020

Buon Giorno a tutte/i.

Ricordavo di avere qualcosa di utilizzabile per questa richiesta

Dunque sperando di fare cosa gradita, lo inserisco qui di seguito.

Codice:

Option Explicit
Sub Main
'Estratti Recenti Ripetuti Isotopi Script By Joe
   Dim Ini,Fin,Es,R,P,Q,E,GR
   Q = 45 : Ini = EstrazioneFin - Q : Fin = EstrazioneFin
   Titoli
   For Es = Ini To Fin  : AvanzamentoElab Ini,Fin,Es
   Scrivi "|" & Space(1),False,False
      Scrivi DataEstrazione(Es) & Space(1),True,False
      Scrivi "|" & Space(1),False,False
      For R = 1 To 12 :If R = 11 Then R = 12
         For P = 1 To 5
            E = Estratto(Es,R,P)
            If Posizione(Es - 1,R,E) = P Then ColoreTesto 2 : GR = True
            If Posizione(Es + 1,R,E) = P Then ColoreTesto 2 : GR = True
            Scrivi Format2(E) & Space(1),GR,0
            ColoreTesto 0 : GR = 0
         Next
         Scrivi "|" & Space(1),False,False
      Next
      Scrivi
   Next
   Titoli
End Sub
Sub Titoli
   Dim R,LNR,Sp1,Sp2
   Scrivi "|" & Space(1),False,False
   Scrivi Space(3) & "Data" & Space(4),True,False
   Scrivi "|",False,False
   For R = 1 To 12 : If R = 11 Then R = 12
      LNR = Len(NomeRuota(R)) : Sp1 = Int((16 - LNR)/2) : Sp2 =(16 - LNR - Sp1)
      Scrivi Space(Sp1) & NomeRuota(R) & Space(Sp2),True,False
      Scrivi "|",False,False
   Next : Scrivi
End Sub

TIGERSUITE · 3 Marzo 2020

ora che lo vedo ...c'e la possibilita di avere più estrazioni ? Anche se cosi va bene

ma ci fosse l'opzione di interagire con altre date riesco a studiare meglio altri casi
comunque vada grazie !

joe · 3 Marzo 2020

Ciao,

nello stesso script al messaggio precedente,

ho allargato il periodo di ricerca alla quantità di 46 estrazioni.

Cioè 3 mesi abbondanti e, a grandi linee, quante ne può contenere, la schermata.

Lo script non ha inputbox ma legge l'ultima estrazione di riferimento

ed essa coincide con il limite dell'archivio utilizzato.

Dunque se per esempio fissi come estrazione finale 31/12/2019.

avrai a video gli ultimi 3 mesi dello scorso anno.

In essi, anche l'esempio che hai riportato in grafica.

Oppure se necessario puoi facilmente aumentare il valore di Q

(ad esempio con Q = 155 avrai tutto l'ultimo anno ) e poi necessariamente

dovrai utilizzare le funzioni di scorrimento della grafica per leggere i risultati,

che occuperanno circa 3 schermate.

TIGERSUITE · 3 Marzo 2020

Alien. · 6 Marzo 2020

è non male,se è possibile: script che immetti un mero di una ruota o tutte e ti dice con quali altri numeri si è unito più volte,ritardi e frequenze ,che se pho fa?,grazie.

Scusa Tiger ho usato il "cavallo di Troia" hahahahhahaha

TIGERSUITE · 6 Marzo 2020

Alien. ha scritto:
è non male,se è possibile: script che immetti un mero di una ruota o tutte e ti dice con quali altri numeri si è unito più volte,ritardi e frequenze ,che se pho fa?,grazie.

Scusa Tiger ho usato il "cavallo di Troia" hahahahhahaha

se siamo utili per migliorare tutto va bene...

Cerca

Cerca

richiesta script 1 e 2 ...

TIGERSUITE

Super Member >GOLD<

i legend

Premium Member

i legend

Premium Member

i legend

Premium Member

TIGERSUITE

Super Member >GOLD<

TIGERSUITE

Super Member >GOLD<

i legend

Premium Member

joe

Advanced Member >PLATINUM PLUS<

TIGERSUITE

Super Member >GOLD<

joe

Advanced Member >PLATINUM PLUS<

TIGERSUITE

Super Member >GOLD<

Alien.

Advanced Premium Member

TIGERSUITE

Super Member >GOLD<

Ultima estrazione Lotto

Ultimi Messaggi