Novità

Spiamo i Giorni

adispo2000

adispo2000

Super Member >PLATINUM<
Ciao a tutti e da molto..che non entro...volevo sapere se Mike, salvo50 ecc...possono riprendere il lavoro di avatar aggiornandolo...tipo l'archivio in automatico la numerazione ecc.....ciao
 
adispo2000;n2144048 ha scritto:
Ciao a tutti e da molto..che non entro...volevo sapere se Mike, salvo50 ecc...possono riprendere il lavoro di avatar aggiornandolo...tipo l'archivio in automatico la numerazione ecc.....ciao
Clicca per espandere...

Ciao a Tutti

Mi dispiace non ti posso aiutare, non ho la più pallida idea di cosa sia il lavoro di avatar
 
scusa salvo....se vuoi ti allego il file che tu o altri con esperieza potreste vedere per riprogrammarlo con un script...carpendo le formule adottate.....ciao
 
chi riesce ad aggiustare il file exel (aggiornare le date ecc..) oppure a scrivere uno script utilizzano gli stessi criteri
 
Troppo complicato per me, questo è uno script che possono fare i vari Joe, Mike58, Claudio8 ecc...
 
Ciao a Tutti.

Sono qua nel forum, se non intervengono, probabilmente è perchè hanno altro da fare, oppure c'è troppo lavoro da fare, oppure ecc...
 
CIAO SALVO COME MAI QUESTO SCRIPT NON CONTROLLA LE ESTRAZIONI DEL 2018?

'Progetto - chiesto da Adispo2000 -
'Script - by Salvo50
Option Explicit
Sub Main
Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4,p3,p4
Dim fin,Ini,caso,casi,clp,esq,somma1,somma2,idestr,col,esqcol
Dim ru(1),posta(4),num(6)
Dim Sove1,Sove2,d1,d2,d3,d4,c1,c2,c3,c4,e1,e2,e3,e4,f1,f2,f3,f4
fin = EstrazioneFin
esq = InputBox("Inserisci l'estrazione che vuoi iniziare",idestr,9300)
clp = InputBox("Per quanti colpi vuoi fare la ricerca",,10)
col = CInt(InputBox(" Quante estrazioni vuoi controllare ",,100))
posta(2) = 1
posta(3) = 1
esqcol = esq + col
If esqcol > fin Then esqcol = fin
For es = esq To esqcol
AvanzamentoElab esq,esqcol,es
caso = 0
For r1 = 1 To 10
For p1 = 1 To 4
For p2 = p1 + 1 To 5
estr1 = Estratto(es,r1,p1)
estr2 = Estratto(es,r1,p2)
For r2 = r1 + 1 To 11
If r2 = 11 Then r2 = 12
For p3 = 1 To 4
For p4 = p3 + 1 To 5
estr3 = Estratto(es,r2,p3)
estr4 = Estratto(es,r2,p4)
e1 = estr1 : e2 = estr2 : e3 = estr3 : e4 = estr4
If Figura(e1) = Figura(e2)And Figura(e1) = Figura(e3) And Figura(e1) = Figura(e4) Then
d1 = Decina(e1) : d2 = Decina(e2) : d3 = Decina(e3) : d4 = Decina(e4)
c1 = Cadenza(e1) : c2 = Cadenza(e2) : c3 = Cadenza(e3) : c4 = Cadenza(e4)
If(d1) = 0 Then
d1 = c1 : c1 = 0
End If
If(d2) = 0 Then
d2 = c2 : c2 = 0
End If
If(d3) = 0 Then
d3 = c3 : c3 = 0
End If
If(d4) = 0 Then
d4 = c4 : c4 = 0
End If
e1 = d1 & c1 : e2 = d2 & c2 : e3 = d3 & c3 : e4 = d4 & c4
f1 = d1 + d3 : f2 = c1 + c3 : f3 = d2 + d4 : f4 = c2 + c4
f1 = Figura(f1) : f2 = Figura(f2) : f3 = Figura(f3) : f4 = Figura(f4)
If c1 = 0 And c3 = 0 Then f2 = 0 'End If
If c2 = 0 And c4 = 0 Then f4 = 0 'End If
somma1 = f1 & f2
somma2 = f3 & f4
somma1 = Fuori90(somma1)
somma2 = Fuori90(somma2)

Scrivi
caso = caso + 1
casi = casi + 1
ColoreTesto 1
Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
ColoreTesto 2
Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
ColoreTesto 0
Scrivi
Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),0,0
Scrivi " Numeri scelti " & Format2(estr1) & " " & Format2(estr2)
Scrivi " Seconda Ruota " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2),0,0
Scrivi " Numeri scelti " & Format2(estr3) & " " & Format2(estr4)
Scrivi
Scrivi Space(30) & Format2(e1) & " " & Format2(e2)
Scrivi Space(30) & Format2(e3) & " " & Format2(e4)
Scrivi Space(30) & String(5,"-")
Scrivi Space(30) & Format2(somma1) & " " & Format2(somma2)
Scrivi
ru(1) = TU_
num(1) = estr1
num(2) = estr2
num(3) = estr3
num(4) = estr4
num(5) = somma1
num(6) = somma2
EliminaRipetuti num
ImpostaGiocata 1,num,ru,posta,clp
Gioca es
End If
Next
Next
Next
Next
Next
Next
Next
ScriviResoconto
End Sub
 
adispo2000;n2145252 ha scritto:
scusa salvo per il disturbo.....ma e' da molto che non l'ho usavo....e ho capito l'errore che commetevo...scusatemi
Clicca per espandere...

Ciao Adispo2000, ho fatto qualche modifica, come ultima estrazione ho messo l'ultima in archivio, ed ho inserito - ScegliRange -


Codice: 
'Progetto - chiesto da Adispo2000 -
'Script - by Salvo50
Option Explicit
Sub Main
   Dim r1,p1,p2,es,r2,estr1,estr2,estr3,estr4,p3,p4
   Dim fin,Ini,caso,casi,clp,somma1,somma2
   Dim ru(1),posta(4),num(6)
   Dim Sove1,Sove2,d1,d2,d3,d4,c1,c2,c3,c4,e1,e2,e3,e4,f1,f2,f3,f4
   fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9500)
   clp = InputBox("Per quanti colpi vuoi fare la ricerca",,10)
   Call ScegliRange(EstrazioneIni,EstrazioneFin,Ini,fin)
   posta(2) = 1
   posta(3) = 1
   For es = Ini To fin
      AvanzamentoElab Ini,fin,es
      caso = 0
      For r1 = 1 To 10
         For p1 = 1 To 4
            For p2 = p1 + 1 To 5
               estr1 = Estratto(es,r1,p1)
               estr2 = Estratto(es,r1,p2)
               For r2 = r1 + 1 To 11
                  If r2 = 11 Then r2 = 12
                  For p3 = 1 To 4
                     For p4 = p3 + 1 To 5
                        estr3 = Estratto(es,r2,p3)
                        estr4 = Estratto(es,r2,p4)
                        e1 = estr1 : e2 = estr2 : e3 = estr3 : e4 = estr4
                        If Figura(e1) = Figura(e2)And Figura(e1) = Figura(e3) And Figura(e1) = Figura(e4) Then
                           d1 = Decina(e1) : d2 = Decina(e2) : d3 = Decina(e3) : d4 = Decina(e4)
                           c1 = Cadenza(e1) : c2 = Cadenza(e2) : c3 = Cadenza(e3) : c4 = Cadenza(e4)
                           If(d1) = 0 Then
                              d1 = c1 : c1 = 0
                           End If
                           If(d2) = 0 Then
                              d2 = c2 : c2 = 0
                           End If
                           If(d3) = 0 Then
                              d3 = c3 : c3 = 0
                           End If
                           If(d4) = 0 Then
                              d4 = c4 : c4 = 0
                           End If
                           e1 = d1 & c1 : e2 = d2 & c2 : e3 = d3 & c3 : e4 = d4 & c4
                           f1 = d1 + d3 : f2 = c1 + c3 : f3 = d2 + d4 : f4 = c2 + c4
                           f1 = Figura(f1) : f2 = Figura(f2) : f3 = Figura(f3) : f4 = Figura(f4)
                           If c1 = 0 And c3 = 0 Then f2 = 0 'End If
                           If c2 = 0 And c4 = 0 Then f4 = 0 'End If
                           somma1 = f1 & f2
                           somma2 = f3 & f4
                           somma1 = Fuori90(somma1)
                           somma2 = Fuori90(somma2)
                           Scrivi
                           caso = caso + 1
                           casi = casi + 1
                           ColoreTesto 1
                           Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(casi,"0000")
                           ColoreTesto 2
                           Scrivi String(80,"o") & " Estrazione " &(es) & " caso " & FormattaStringa(caso,"0000")
                           ColoreTesto 0
                           Scrivi
                           Scrivi(" Estrazione n." & Format2(es) & " del " & DataEstrazione(es)),0,0
                           Scrivi " " & Left(NomeRuota(r1),2) & " " & StringaEstratti(es,r1),0,0
                           Scrivi " Numeri scelti " & Format2(estr1) & " " & Format2(estr2)
                           Scrivi " Seconda Ruota " & Left(NomeRuota(r2),2) & " " & StringaEstratti(es,r2),0,0
                           Scrivi " Numeri scelti " & Format2(estr3) & " " & Format2(estr4)
                           Scrivi
                           Scrivi Space(30) & Format2(e1) & " " & Format2(e2)
                           Scrivi Space(30) & Format2(e3) & " " & Format2(e4)
                           Scrivi Space(30) & String(5,"-")
                           Scrivi Space(30) & Format2(somma1) & " " & Format2(somma2)
                           Scrivi
                           ru(1) = TU_
                           num(1) = estr1
                           num(2) = estr2
                           num(3) = estr3
                           num(4) = estr4
                           num(5) = somma1
                           num(6) = somma2
                           EliminaRipetuti num
                           ImpostaGiocata 1,num,ru,posta,clp
                           Gioca es
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
   Next
   ScriviResoconto
End Sub
 
sempre grazie.....................potresti farmi partire questo script


Sub Main()
' statistica per rilevamento delle somme dei 20 estratti a gruppi da ambo-terno-quaterna-cinquina-etc...'
'-------------------------------------------------------------------------------------------------------------------------------
ImpostaArchivio10ELotto(2)
Dim num(20)
Dim asom(20)
Dim acolpi(9999)
storia = InputBox("Statistica Ult.Estrazione da Considerare ",,EstrazioniArchivioDL)
z = InputBox("Quante Estrazione vuoi esaminare? ",,50)
v = InputBox("somma nr.consecutivi 2,3,4,5",,5)
lis = InputBox("Estratto=1, ambo=2, Terno=3, Quaterna=4, Cinquina=5",,5)
acc = InputBox("Accorpa giocate Si-No ",,"S")
fin = storia
Ini = storia - z
Scrivi "Rileva somme numeri dal concorso n." & Ini & " al conc.n. " & fin & " Per il 10 E LOTTO 5 minuti - by Rubino - "
Scrivi "Somma nr. consecutività.." & v
Scrivi "Accorpa giocate.." & acc
Scrivi "Verifica esito : segnala punteggio >= di..." & lis
Scrivi "Conc.n. 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 ........somme......... 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20"
Scrivi "_________________________________________________ __________________________________________________ __________________________________________________ _"
For x = 1 To z
idestr = storia - x
riga = ""
For t = 1 To 20
asom(t) = ""
Next
For yy = 1 To 20
riga = riga & Format2(EstrattoDL(idestr,yy)) & " "
num(yy) = Format2(EstrattoDL(idestr,yy))
Next
If v = 2 Then
For b = 1 To 19
c = Fuori90(Int(num(b)) + Int(num(b + 1)))
asom(b) = asom(b) & CLng(c)
Next
lim = 19
End If
If v = 3 Then
For b = 1 To 18
c = Fuori90(Int(num(b)) + Int(num(b + 1)) + Int(num(b + 2)))
asom(b) = asom(b) & CLng(c)
Next
lim = 18
End If
If v = 4 Then
For b = 1 To 17
c = Fuori90(Int(num(b)) + Int(num(b + 1)) + Int(num(b + 2)) + Int(num(b + 3)))
asom(b) = asom(b) & CLng(c)
Next
lim = 17
End If
If v = 5 Then
For b = 1 To 16
c = Fuori90(Int(num(b)) + Int(num(b + 1)) + Int(num(b + 2)) + Int(num(b + 3)) + Int(num(b + 4)))
asom(b) = asom(b) & CLng(c)
Next
lim = 16
End If
rsomme = ""
For f = 1 To Int(lim)
rsomme = rsomme & Format2(asom(f)) & " "
Next
Scrivi "_________________________________________________ __________________________________________________ __________________________________________________ ______"
ColoreTesto(0)
Scrivi idestr & " " & riga & "......................." & rsomme
''''riepilogo terni con somme uguali
For r = 1 To lim
For r2 = r + 1 To lim + 1
If asom(r) = asom(r2) Then
t1 = Format2(EstrattoDL(idestr,r))
t2 = Format2(EstrattoDL(idestr,r + 1))
If v = 3 Then
t3 = Format2(EstrattoDL(idestr,r + 2))
End If
If v = 4 Then
t3 = Format2(EstrattoDL(idestr,r + 2))
t4 = Format2(EstrattoDL(idestr,r + 3))
End If
If v = 5 Then
t3 = Format2(EstrattoDL(idestr,r + 2))
t4 = Format2(EstrattoDL(idestr,r + 3))
t5 = Format2(EstrattoDL(idestr,r + 4))
End If
u1 = Format2(EstrattoDL(idestr,r2))
u2 = Format2(EstrattoDL(idestr,r2 + 1))
If v = 3 Then
u3 = Format2(EstrattoDL(idestr,r2 + 2))
End If
If v = 4 Then
u3 = Format2(EstrattoDL(idestr,r2 + 2))
u4 = Format2(EstrattoDL(idestr,r2 + 3))
End If
If v = 5 Then
u3 = Format2(EstrattoDL(idestr,r2 + 2))
u4 = Format2(EstrattoDL(idestr,r2 + 3))
u5 = Format2(EstrattoDL(idestr,r2 + 4))
End If
ColoreTesto(1)
Scrivi "------ somma.." & Format2(asom(r)) & " ............" & t1 & " " & t2 & " " & t3 & " " & t4 & " " & t5 & " " & u1 & " " & u2 & " " & u3 & " " & u4 & " " & u5
ReDim tnm(10)
For j = 1 To 10
tnm(j) = 0
Next
tnm(1) = t1
tnm(2) = t2
tnm(3) = t3
tnm(4) = t4
tnm(5) = t5
''''''' accorpa giocate in una unica
If acc = "S" Then
 
Ciao a Tutti.

Manca la parte finale dello script, negli script che ho io, ho trovato questo che mi sembra uguale, provalo.

Codice: 
Sub Main()
   'http://forum.lottoced.com/forum/lottoced/area-download/103186-raccolta-di-sript-per-10elotto-5-m/page2
   ' statistica per rilevamento delle somme dei 20 estratti a gruppi da ambo-terno-quaterna-cinquina-etc...'
   '-------------------------------------------------------------------------------------------------------------------------------
   Dim num(20)
   Dim asom(20)
   Dim acolpi(9999)
   Dim n(20)
   Dim Tipoarchivio
   Tipoarchivio = ScegliArchivio
   If Tipoarchivio > 00 Then
      If Tipoarchivio = 02 Then
         If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",vbQuestion + vbYesNo) = vbYes Then
            Call AggiornaArchivioDL
         End If
      End If
      Call ImpostaArchivio10ELotto(Tipoarchivio)
      storia = InputBox("Statistica Ult.Estrazione da Considerare ",,EstrazioniArchivioDL)
      z = InputBox("Quante Estrazione vuoi esaminare? ",,50)
      v = InputBox("nr.Garanzia somma 2,3,4,5",,3)
      lis = InputBox("ambo=2, Terno=3, Quarterna=4, Cinquina=5",,3)
      co2 = InputBox("Verifica se già usciti in n.colpi precedenti..",,100)
      lis2 = InputBox("Verifica quanti punti già sortiti in precedenza..",,3)
      fin = storia
      Ini = storia - z
      Scrivi "Rileva somme numeri dal concorso n." & Ini & " al conc.n. " & fin & " Per il 10 E LOTTO 5  con verifica a ritroso "
      Scrivi "Somma nr. consecutività.." & v
      Scrivi "Conc.n. 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20 ........somme......... 01 02 03 04 05 06 07 08 09 10 11 12 13 14 15 16 17 18 19 20"
      Scrivi "______________________________________________________________________________________________________________________________________________________"
      For x = 1 To z
         idestr = storia - x
         riga = ""
         For t = 1 To 20
            asom(t) = ""
         Next
         For yy = 1 To 20
            riga = riga & Format2(EstrattoDL(idestr,yy)) & " "
            num(yy) = Format2(EstrattoDL(idestr,yy))
         Next
         If v = 2 Then
            For b = 1 To 19
               c = Fuori90(Int(num(b)) + Int(num(b + 1)))
               asom(b) = asom(b) & CLng(c)
            Next
            lim = 19
         End If
         If v = 3 Then
            For b = 1 To 18
               c = Fuori90(Int(num(b)) + Int(num(b + 1)) + Int(num(b + 2)))
               asom(b) = asom(b) & CLng(c)
            Next
            lim = 18
         End If
         If v = 4 Then
            For b = 1 To 17
               c = Fuori90(Int(num(b)) + Int(num(b + 1)) + Int(num(b + 2)) + Int(num(b + 3)))
               asom(b) = asom(b) & CLng(c)
            Next
            lim = 17
         End If
         If v = 5 Then
            For b = 1 To 16
               c = Fuori90(Int(num(b)) + Int(num(b + 1)) + Int(num(b + 2)) + Int(num(b + 3)) + Int(num(b + 4)))
               asom(b) = asom(b) & CLng(c)
            Next
            lim = 16
         End If
         rsomme = ""
         For f = 1 To Int(lim)
            rsomme = rsomme & Format2(asom(f)) & " "
         Next
         Scrivi "___________________________________________________________________________________________________________________________________________________________"
         ColoreTesto(0)
         Scrivi idestr & "   " & riga & "......................." & rsomme
         ''''riepilogo terni con somme uguali
         For r = 1 To lim
            For r2 = r + 1 To lim + 1
               If asom(r) = asom(r2) Then
                  t1 = Format2(EstrattoDL(idestr,r))
                  t2 = Format2(EstrattoDL(idestr,r + 1))
                  If v = 3 Then
                     t3 = Format2(EstrattoDL(idestr,r + 2))
                  End If
                  If v = 4 Then
                     t3 = Format2(EstrattoDL(idestr,r + 2))
                     t4 = Format2(EstrattoDL(idestr,r + 3))
                  End If
                  If v = 5 Then
                     t3 = Format2(EstrattoDL(idestr,r + 2))
                     t4 = Format2(EstrattoDL(idestr,r + 3))
                     t5 = Format2(EstrattoDL(idestr,r + 4))
                  End If
                  u1 = Format2(EstrattoDL(idestr,r2))
                  u2 = Format2(EstrattoDL(idestr,r2 + 1))
                  If v = 3 Then
                     u3 = Format2(EstrattoDL(idestr,r2 + 2))
                  End If
                  If v = 4 Then
                     u3 = Format2(EstrattoDL(idestr,r2 + 2))
                     u4 = Format2(EstrattoDL(idestr,r2 + 3))
                  End If
                  If v = 5 Then
                     u3 = Format2(EstrattoDL(idestr,r2 + 2))
                     u4 = Format2(EstrattoDL(idestr,r2 + 3))
                     u5 = Format2(EstrattoDL(idestr,r2 + 4))
                  End If
                  ''''verifica 1 combinazione nel passato
                  ReDim tnm(5)
                  tnm(1) = Format2(t1)
                  tnm(2) = Format2(t2)
                  tnm(3) = Format2(t3)
                  tnm(4) = Format2(t4)
                  tnm(5) = Format2(t5)
                  ColoreTesto(1)
                  Scrivi
                  Scrivi "------ somma.." & Format2(asom(r)) & " .." & t1 & " " & t2 & " " & t3 & " " & t4 & " " & t5 & " " & u1 & " " & u2 & " " & u3 & " " & u4 & " " & u5
                  ini = idestr
                  ColoreTesto 0
                  Scrivi " VERIFICA SE combinazione GIA' USCITA NEI PRECEDENTI CONCORSI " & tnm(1) & " " & tnm(2) & " " & tnm(3) & " " & tnm(4) & " " & tnm(5)
                  ctz = 0
                  For ccc = ini - Int(co2) To ini - 1
                     For mm = 1 To 20
                        n(mm) = Format2(EstrattoDL(ccc,mm))
                     Next
                     snconc = GetInfoEstrazioneDL(ccc)
                     punti = 0
                     evidenza = ""
                     For q = 1 To 20
                        If Format2(n(q)) = tnm(1) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(2) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(3) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(4) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(5) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                     Next
                     If punti >= Int(lis2) Then
                        ColoreTesto 2
                        If Int(lis2) = 3 Then Scrivi " ------->  Terno    già uscito nel concorso " & ccc & " " & snconc & "...Estratti......" & evidenza
                        If Int(lis2) = 4 Then Scrivi " ------->  Quaterna già uscita nel concorso " & ccc & " " & snconc & "...Estratti......" & evidenza
                        ctz = ctz + 1
                     End If
                  Next
                  If ctz = 0 Then
                     ColoreTesto 2
                     Scrivi " ------->  NESSUNA quantità di numeri richiesta E' USCITA NEI PRECEDENTI CONCORSI "
                     ColoreTesto 0
                  End If
                  esito = 0
                  ColoreTesto 0
                  If VerificaEsitoDL(tnm,idestr + 1,lis,,RetEsito,RetColpi,RetEstratti,RetIdEstr) Then
                     esito = 1
                     ColoreTesto 7
                     Scrivi
                     Scrivi "Esito:  "
                     Call Scrivi(GetInfoEstrazioneDL(RetIdEstr) & " " & RetEsito & " colpi : " & RetColpi & " " & RetEstratti)
                     acolpi(RetColpi) = acolpi(RetColpi) + 1
                     ColoreTesto 0
                     If RetEsito = "Cinquina" Then
                        Cinquitotali = Cinquitotali + 1
                     End If
                     If RetEsito = "Quaterna" Then
                        Quatetotali = Quatetotali + 1
                     End If
                     If RetEsito = "Terno" Then
                        ternitotali = ternitotali + 1
                     End If
                     If RetEsito = "Ambo" Then
                        ambitotali = ambitotali + 1
                     End If
                  Else
                     If esito = 0 Then Scrivi " Esito NEGATIVO o IN CORSO "
                  End If
                  ''''' ----------------------------------------------------------------------------------------------------------------------------
                  ''''' 2 combinazione verifica nel passato
                  ReDim tnm(5)
                  tnm(1) = Format2(u1)
                  tnm(2) = Format2(u2)
                  tnm(3) = Format2(u3)
                  tnm(4) = Format2(u4)
                  tnm(5) = Format2(u5)
                  ColoreTesto 0
                  Scrivi " VERIFICA SE combinazione GIA' USCITA NEI PRECEDENTI CONCORSI " & tnm(1) & " " & tnm(2) & " " & tnm(3) & " " & tnm(4) & " " & tnm(5)
                  ctz = 0
                  For ccc = ini - Int(co2) To ini - 1
                     For mm = 1 To 20
                        n(mm) = Format2(EstrattoDL(ccc,mm))
                     Next
                     snconc = GetInfoEstrazioneDL(ccc)
                     punti = 0
                     evidenza = ""
                     For q = 1 To 20
                        If Format2(n(q)) = tnm(1) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(2) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(3) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(4) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                        If Format2(n(q)) = tnm(5) Then
                           punti = punti + 1
                           evidenza = evidenza & n(q) & " "
                        End If
                     Next
                     ColoreTesto 2
                     If punti >= Int(lis2) Then
                        If Int(lis2) = 3 Then Scrivi " ------->  Terno    già uscito nel concorso " & ccc & " " & snconc & "...Estratti......" & evidenza
                        If Int(lis2) = 4 Then Scrivi " ------->  Quaterna già uscita nel concorso " & ccc & " " & snconc & "...Estratti......" & evidenza
                        ctz = ctz + 1
                     End If
                  Next
                  If ctz = 0 Then
                     ColoreTesto 2
                     Scrivi " ------->  NESSUNA quantità di numeri richiesta E' USCITA NEI PRECEDENTI CONCORSI "
                     ColoreTesto 0
                  End If
                  ColoreTesto 0
                  esito = 0
                  If VerificaEsitoDL(tnm,idestr + 1,lis,,RetEsito,RetColpi,RetEstratti,RetIdEstr) Then
                     esito = 1
                     ColoreTesto 7
                     Scrivi
                     Scrivi "Esito:  "
                     Call Scrivi(GetInfoEstrazioneDL(RetIdEstr) & " " & RetEsito & " colpi : " & RetColpi & " " & RetEstratti)
                     acolpi(RetColpi) = acolpi(RetColpi) + 1
                     ColoreTesto 0
                     If RetEsito = "Cinquina" Then
                        Cinquitotali = Cinquitotali + 1
                     End If
                     If RetEsito = "Quaterna" Then
                        Quatetotali = Quatetotali + 1
                     End If
                     If RetEsito = "Terno" Then
                        ternitotali = ternitotali + 1
                     End If
                     If RetEsito = "Ambo" Then
                        ambitotali = ambitotali + 1
                     End If
                  Else
                     If esito = 0 Then Scrivi " Esito NEGATIVO o IN CORSO "
                  End If
               End If
            Next
         Next
      Next
      ColoreTesto 0
      Scrivi "Ambi totali realizzati..." & ambitotali
      Scrivi "Terni totali realizzati..." & ternitotali
      Scrivi "Quaterne totali realizzati..." & Quatetotali
      Scrivi "Cinquine totali realizzati..." & Cinquitotali
      Scrivi "concorsi esaminati totale.." & z
      'For n = 1 To 999
      ' If acolpi(n) > 0 Then
      ' Scrivi Format2(n) & "°.colpo.." & acolpi(n)
      ' End If
      'Next
   End If
End Sub
Function ScegliArchivio()
   ReDim aVoci(01)
   aVoci(00) = "10 e lotto Serale"
   aVoci(01) = "10 e lotto 5minuti"
   ScegliArchivio = ScegliOpzioneMenu(aVoci,00,"Secegli archivio") + 01
End Function
 
Ultima modifica:
CIAO SALVO PUOI MODIFICARE QUESTO SCRIPT FATTO PER ME DA MIKE..ANCHE PER IL SUPERENALOTTO E SE E' POSSIBILE PER IL LOTTO?
iN CASO DI RISPOSTA POSITIVA PER IL LOTTO AVERE LA POSSIBILITA' DI SCEGLIERE O RUOTA SINGOLA O TUTTE....CIAO

Option Explicit
'Per tutti gli scripter Metodi Terno Mancato di adispo2000
'http://forum.lottoced.com/forum/lottoced/area-download/2069029-per-tutti-gli-scripter-metodi-terno-mancato
Sub Main()
Dim Tipoarchivio : Tipoarchivio = ScegliArchivioDL()
If Tipoarchivio > 00 Then
If Tipoarchivio = 02 Then
If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",vbQuestion + vbYesNo) = vbYes Then
Call AggiornaArchivioDL()
End If
End If
Call ImpostaArchivio10ELotto(Tipoarchivio)
Dim EstrCon : EstrCon = CInt(InputBox("ESTRAZIONI RICERCA FRREQUENTI","ricerca Frequenti",5))
Dim nClasse : nClasse = CInt(InputBox("CLASSE SVILUPPO","Sviluppo",3))
Dim Ini,fin : Ini = EstrazioneFinDL - EstrCon : fin = EstrazioneFinDL - 01
Dim Y,nFrq01 : ReDim nFr01(90,01)
For Y = 01 To 90
nFr01(Y,00) = Format2(Y)
nFr01(Y,01) = EstrattoFrequenzaDL(Y,Ini,fin)
nFrq01 = EstrattoFrequenzaDL(Y,Ini,fin)
Next
Call OrdinaMatriceTurbo(nFr01,- 01,01)
ReDim EN(05) : EN(01) = nFr01(01,00) : EN(02) = nFr01(02,00) : EN(03) = nFr01(03,00) : EN(04) = nFr01(04,00) : EN(05) = nFr01(05,00)
Dim aNumeri :aNumeri = Array(EN(01),EN(02),EN(03),EN(04),EN(05))
Call Scrivi("Sviluppo combinazione " & StringaNumeri(aNumeri) & " In " & NomeSorte(nClasse),,01) : Call Scrivi()
Dim k
For k = 01 To UBound(aNumeri)
aNumeri(k) = aNumeri(k)
Next
Dim aTitoli : aTitoli = Array(aTitoli," CONTATORE "," SVILUPPO " & NomeSorte(nClasse)," ESITO "," COLPI "," ESTRATTI "," ID ESTR ")
Call InitTabella(aTitoli,03,,03,01)
Dim aCol
If InitSviluppoIntegrale(aNumeri,nClasse) > 00 Then
Do While GetCombSviluppo(aCol) = True
Dim i : i = i + 01
Dim RetEsito,RetColpi,RetEstratti,RetIdEstr
Call VerificaEsitoDL(aCol,Ini,nClasse,EstrCon + 01,RetEsito,RetColpi,RetEstratti,RetIdEstr)
Dim aValori : aValori = Array(aValori,FormattaStringa(i,"00"),StringaNumer i(aCol,,True),RetEsito,RetColpi,RetEstratti,RetIdE str)
If RetEsito <> "" Then
aValori(06) = GetInfoEstrazioneDL(RetIdEstr)
ElseIf RetEsito = "" Then
aValori(03) = " -- " : aValori(06) = " -- "
End If
Call AddRigaTabella(aValori,,,03)
Loop
End If
Call CreaTabella()
End If
End Sub
Function ScegliArchivioDL()
ReDim aVoci(01)
aVoci(00) = "10 e lotto Serale"
aVoci(01) = "10 e lotto 5minuti"
ScegliArchivioDL = ScegliOpzioneMenu(aVoci,00,"Scegli archivio 10eLotto") + 01
End Function
 
Ultima modifica:
Ciao a Tutti.

Ciao Adispo2000, mi stai sopravvalutando, io non sono così bravo, comunque penso che dato che lo script è di Mke, è meglio che lo modifichi lui.
 
Ci sono poco Causa impegni vari, comunque ecco lo script adattato al lotto.
L'ho lasciato sporco degli altri codici in quanto non ho capito se da adattare anche per il Superenalotto ( Basterebbe cambiare i codici con Suffisso SE anziché DL.

eccolo per il lotto.

Codice: 
Option Explicit
'Per tutti gli scripter Metodi Terno Mancato di adispo2000
'http://forum.lottoced.com/forum/lottoced/area-download/2069029-per-tutti-gli-scripter-metodi-terno-mancato
Sub Main()
   'Dim Tipoarchivio : Tipoarchivio = ScegliArchivioDL()
   'If Tipoarchivio > 00 Then
      'If Tipoarchivio = 02 Then
        ' If MsgBox("Vuoi aggiornare le estrazioni prima di eseguire il listato",vbQuestion + vbYesNo) = vbYes Then
            'Call AggiornaArchivioDL()
         'End If
      'End If
     ' Call ImpostaArchivio10ELotto(Tipoarchivio)
      Dim r,ru(1)' ruota
      r = InputBox("Quale Ruota",,1)
      Dim sorte : sorte = InputBox("Quale Sorte Di VerificaEsito",,2)
      Dim EstrCon : EstrCon = CInt(InputBox("ESTRAZIONI RICERCA FRREQUENTI","ricerca Frequenti",5))
      Dim nClasse : nClasse = CInt(InputBox("CLASSE SVILUPPO","Sviluppo",3))
      Dim Ini,fin : Ini = EstrazioneFinDL - EstrCon : fin = EstrazioneFinDL - 01
      Dim Y,nFrq01 : ReDim nFr01(90,01)
      ru(1) = r
      For Y = 01 To 90
         nFr01(Y,00) = Format2(Y)
         nFr01(Y,01) = EstrattoFrequenza(Y,r,Ini,fin)
         nFrq01 = EstrattoFrequenza(Y,r,Ini,fin)
      Next
      Call OrdinaMatriceTurbo(nFr01,- 01,01)
      ReDim EN(05) : EN(01) = nFr01(01,00) : EN(02) = nFr01(02,00) : EN(03) = nFr01(03,00) : EN(04) = nFr01(04,00) : EN(05) = nFr01(05,00)
      Dim aNumeri :aNumeri = Array(EN(01),EN(02),EN(03),EN(04),EN(05))
      Call Scrivi("Sviluppo combinazione " & StringaNumeri(aNumeri) & " In " & NomeSorte(nClasse),,01) : Call Scrivi()
      Dim k
      For k = 01 To UBound(aNumeri)
         aNumeri(k) = aNumeri(k)
      Next
      Dim aTitoli : aTitoli = Array(aTitoli," CONTATORE "," SVILUPPO " & NomeSorte(nClasse)," ESITO "," COLPI "," ESTRATTI "," ID ESTR ")
      Call InitTabella(aTitoli,03,,03,01)
      Dim aCol
      If InitSviluppoIntegrale(aNumeri,nClasse) > 00 Then
         Do While GetCombSviluppo(aCol) = True
            Dim i : i = i + 01
            Dim RetEsito,RetColpi,RetEstratti,RetIdEstr
            Call VerificaEsito(aCol,ru,Ini,sorte,EstrCon + 01,,RetEsito,RetColpi,RetEstratti,RetIdEstr)
            Dim aValori : aValori = Array(aValori,FormattaStringa(i,"00"),StringaNumeri(aCol,,True),RetEsito,RetColpi,RetEstratti,RetIdEstr)
            If RetEsito <> "" Then
               aValori(06) = GetInfoEstrazione(RetIdEstr)
            ElseIf RetEsito = "" Then
               aValori(03) = " -- " : aValori(06) = " -- "
            End If
            Call AddRigaTabella(aValori,,,03)
         Loop
      End If
      Call CreaTabella()
   'End If
End Sub
'Function ScegliArchivioDL()
   'ReDim aVoci(01)
   'aVoci(00) = "10 e lotto Serale"
   'aVoci(01) = "10 e lotto 5minuti"
   'ScegliArchivioDL = ScegliOpzioneMenu(aVoci,00,"Scegli archivio 10eLotto") + 01
'End Function


Buon Anno a Tutti
 
Scusami Mike..ti ringrazio sempre a te e a tutti le persone che mi sopportano, ti auguro a te, e ad altri scripter buan anno......ma una cosa posso dirtela ma come faccio a farlo per il superenalotto.........:(
 
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 16 gennaio 2025
    Bari
    47
    33
    54
    51
    58
    Cagliari
    58
    88
    03
    30
    65
    Firenze
    76
    56
    16
    73
    29
    Genova
    78
    58
    71
    18
    26
    Milano
    09
    74
    15
    26
    57
    Napoli
    75
    81
    35
    59
    17
    Palermo
    17
    39
    46
    54
    08
    Roma
    28
    75
    76
    02
    23
    Torino
    24
    36
    80
    87
    89
    Venezia
    86
    70
    37
    23
    45
    Nazionale
    09
    65
    30
    06
    07
    Estrazione Simbolotto
    Bari
    21
    43
    01
    02
    19
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto