Novità

Spiamo i Giorni

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
 

salvo50

Advanced Member >PLATINUM PLUS<
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

Ciao a Tutti

Mi dispiace non ti posso aiutare, non ho la più pallida idea di cosa sia il lavoro di avatar
 

adispo2000

Super Member >PLATINUM<
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
 

adispo2000

Super Member >PLATINUM<
chi riesce ad aggiustare il file exel (aggiornare le date ecc..) oppure a scrivere uno script utilizzano gli stessi criteri
 

salvo50

Advanced Member >PLATINUM PLUS<
Troppo complicato per me, questo è uno script che possono fare i vari Joe, Mike58, Claudio8 ecc...
 

salvo50

Advanced Member >PLATINUM PLUS<
Ciao a Tutti.

Sono qua nel forum, se non intervengono, probabilmente è perchè hanno altro da fare, oppure c'è troppo lavoro da fare, oppure ecc...
 

adispo2000

Super Member >PLATINUM<
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
 

salvo50

Advanced Member >PLATINUM PLUS<
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

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
 

adispo2000

Super Member >PLATINUM<
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
 

salvo50

Advanced Member >PLATINUM PLUS<
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:

adispo2000

Super Member >PLATINUM<
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:

salvo50

Advanced Member >PLATINUM PLUS<
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.
 

Mike58

Advanced Member >PLATINUM PLUS<
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
 

adispo2000

Super Member >PLATINUM<
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.........:(
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 28 marzo 2024
    Bari
    49
    73
    67
    86
    19
    Cagliari
    64
    36
    37
    02
    04
    Firenze
    66
    27
    44
    90
    17
    Genova
    09
    44
    78
    85
    19
    Milano
    70
    14
    47
    38
    27
    Napoli
    80
    29
    28
    45
    39
    Palermo
    54
    59
    78
    47
    62
    Roma
    17
    22
    49
    52
    88
    Torino
    71
    35
    75
    74
    60
    Venezia
    40
    84
    02
    63
    29
    Nazionale
    08
    13
    44
    69
    85
    Estrazione Simbolotto
    Firenze
    06
    35
    16
    18
    05

Ultimi Messaggi

Alto