SCRIPT x ricerca__AdattatoriSommativi & Altro

Giulio LG · 16 Settembre 2012

Inc.Cron.Rit.MAX ( Autori LuigiBi & lotto_tom75 )

Inc.Cron.Rit.MAX ( Autori LuigiBi & lotto_tom75 )

Codice:

Option Explicit
Class clsParStat
Dim idEstr
Dim RitMax
Dim IncrRitMax
End Class
Sub Main
Dim idEstr,Ruota,Sorte
Dim Inizio,Fine
Dim k,p,i,r,pMax
Dim Rit,RitMax,IncRitMax,Fre
Dim collStoria
Dim cParStat
Dim bEstrValida
Set collStoria = GetNewCollection
Inizio = EstrazioneIni
Fine = EstrazioneFin
ReDim aN(90)
If ScegliFormazione(aN) Then
  Ruota = ScegliRuotaEx
  Sorte = ScegliEsito
  If Ruota > 0 And Sorte > 0 Then
   For idEstr = Inizio To Fine
    If Ruota = 11 Then
     bEstrValida = False
     pMax = 0
     For r = 1 To 10
      If Estratto(idEstr,r,1) > 0 Then bEstrValida = True
      p = 0
      For k = 1 To 5
       If aN(Estratto(idEstr,r,k)) Then
        p = p + 1
       End If
      Next
      If p > pMax Then pMax = p
     Next
     If bEstrValida Then
      If pMax >= Sorte Then
       If IncRitMax > 0 Then
        Set cParStat = New clsParStat
        cParStat.IdEstr = idEstr - 1
        cParStat.RitMax = RitMax
        cParStat.IncrRitMax = IncRitMax
        collStoria.add cParStat
       End If
       Rit = 0
       Fre = Fre + 1
       IncRitMax = 0
      Else
       Rit = Rit + 1
       If Rit > RitMax Then
        IncRitMax = IncRitMax + 1
        RitMax = Rit
       End If
      End If
     End If
    Else
     If Estratto(idEstr,Ruota,1) > 0 Then
      p = 0
      For k = 1 To 5
       If aN(Estratto(idEstr,Ruota,k)) Then
        p = p + 1
       End If
      Next
      If p >= Sorte Then
       If IncRitMax > 0 Then
        Set cParStat = New clsParStat
        cParStat.IdEstr = idEstr - 1
        cParStat.RitMax = RitMax
        cParStat.IncrRitMax = IncRitMax
        collStoria.add cParStat
       End If
       Rit = 0
       Fre = Fre + 1
       IncRitMax = 0
      Else
       Rit = Rit + 1
       If Rit > RitMax Then
        IncRitMax = IncRitMax + 1
        RitMax = Rit
       End If
      End If
     End If
    End If
    Call AvanzamentoElab(Inizio,Fine,idEstr)
    If ScriptInterrotto Then Exit For
   Next
   If IncRitMax > 0 Then
    Set cParStat = New clsParStat
    cParStat.IdEstr = idEstr - 1
    cParStat.RitMax = RitMax
    cParStat.IncrRitMax = IncRitMax
    collStoria.add cParStat
   End If
   Call GestioneOutput(collStoria,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre)
  Else
   MsgBox "Ruota non valida"
  End If
End If
End Sub
Function ScegliFormazione(aN)
Dim sFormazione
Dim k,i
sFormazione = InputBox("Inserire la formazione da analizzare separando i numeri che la compongono con il punto",,"1.10.20")
ReDim aV(0)
Call SplitByChar(sFormazione,".",aV)
For k = 0 To UBound(aV)
  If Int(aV(k)) > 0 And Int(aV(k)) <= 90 Then
   aN(Int(aV(k))) = True
   i = i + 1
  End If
Next
If i > 0 Then ScegliFormazione = True
End Function
Sub GestioneOutput(coll,RitMax,aN,Sorte,Inizio,Fine,Ruota,Rit,Fre)
Dim x,y,k
Dim sFrz
Dim clsP
For k = 1 To 90
  If aN(k) Then
   sFrz = sFrz & Format2(k) & "."
  End If
Next
sFrz = Left(sFrz,Len(sFrz) - 1)
Call Scrivi("Sulla ruota di        : " & NomeRuota(Ruota))
Call Scrivi
Call Scrivi("Formazione analizzata : " & sFrz)
Call Scrivi
Call Scrivi("Da Estrazione         : " & GetInfoEstrazione(Inizio))
Call Scrivi("A  Estrazione         : " & GetInfoEstrazione(Fine))
Call Scrivi
Call Scrivi("RitardoAtt            : " & Rit)
Call Scrivi("RitardoMax            : " & RitMax)
Call Scrivi("Frequenza             : " & Fre)
Call Scrivi
Call Scrivi("DETTAGLIO EVOLUZIONE RitMax",True)
For Each clsP In coll
  Call Scrivi("Estrazione : " & FormatSpace(clsP.idEstr,5,True) & _
  " RitMax : " & FormatSpace(clsP.RitMax,5,True) & _
  " Inc.cron.RitMax : " & FormatSpace(clsP.IncrRitMax,5,True))
Next
Call Scrivi
Call Scrivi("Grafico di confronto RitMax / IncRitMax",True)
Call PreparaGrafico("",0,coll.count,0,RitMax,1,5)
' prima riga
ReDim aV(coll.count,2)
For Each clsP In coll
  x = x + 1
  aV(x,1) = x
  aV(x,2) = clsP.RitMax
Next
Call DisegnaLineaGrafico(aV,vbBlue,"RitMax")
x = 0
ReDim aV(coll.count,2)
For Each clsP In coll
  x = x + 1
  aV(x,1) = x
  aV(x,2) = clsP.IncrRitMax
Next
Call DisegnaLineaGrafico(aV,vbRed,"IncRitMax")
' scrive grafico nell'output
Call InserisciGrafico
End Sub
Function ScegliRuotaEx
Dim k
ReDim aV(12)
For k = 1 To 12
  aV(k) = NomeRuota(k)
Next
ScegliRuotaEx = ScegliOpzioneMenu(aV)
End Function

Giulio LG · 24 Settembre 2012

RUOTE_SingoleCoppieTerzineQuartineCinquine ( Autore Rubino )

RUOTE_SingoleCoppieTerzineQuartineCinquine ( Autore Rubino )

Codice:

'Puoi provare a modificare questa riga in fondo allo script e provarlo
'attualmente___For q= 1 To 5
'falla diventare così___For q= 1 To UBound(aretritardi)
Sub Main
Dim colonne
Dim numeri(10),nm(10),ruote(10),max(5000)
Dim classe
Dim scolonna
Dim s,k,ct,ct2,j,y,u,rita,rt1,rt2,ritardo,ritardomax,incrritmax,frequenza,aretritardi,aretidestr,des1,des2,qt,q,ord
Do While qt = ""
  Call ScegliNumeri(numeri)
  If UBound(numeri) >= 11 Then
   MsgBox("max possibile (10 numeri)")
   qt = ""
  Else
   Exit Do
  End If
Loop
Do While classe = ""
  classe = InputBox("sviluppo (classe = ruota).in...(max = 5)",,1)
  If classe >= 6 Then
   MsgBox("max possibile 5) ")
   classe = ""
  Else
   Exit Do
  End If
Loop
Do While s = ""
  s = InputBox("inserire sorte 1,2,3,4,5 ",,2)
  If s >= 6 Then
   MsgBox("max possibile (5) = cinquina ")
   s = ""
  Else
   Exit Do
  End If
Loop
ord = InputBox("riepilogo ordina x colonna...",,4)
ColoreTesto(1)
If classe = 1 Then des1 = " una     ruota"
If classe = 2 Then des1 = " due     ruote"
If classe = 3 Then des1 = " tre     ruote"
If classe = 4 Then des1 = " quattro ruote"
If classe = 5 Then des1 = " cinque  ruote"
If s = 1 Then des2 = " ambata  "
If s = 2 Then des2 = " ambo    "
If s = 3 Then des2 = " terno   "
If s = 4 Then des2 = " quaterna"
If s = 5 Then des2 = " cinquina"
Scrivi " numeri richiesti o inseriti......................" & StringaNumeri(numeri),1
Scrivi " sviluppo della combinazione in classe. Di ruote.." & classe & " " & des1,1
Scrivi " ritardi calcola per la sorte di.................." & s & " " & des2,1
Scrivi "-----------------------------------r-u-b-i-n-o----",1
ReDim atitoli(9)
ReDim avalori(9)
' preimposto i titoli delle colonne
atitoli(1) = " n u m e r i "
atitoli(2) = " ruote "
atitoli(3) = " r.cor."
atitoli(4) = " r.sto "
atitoli(5) = " incr. "
atitoli(6) = " frequ "
atitoli(7) = " u.rp1 "
atitoli(8) = " u.rp2 "
atitoli(9) = " u.rp3 "
' ' inizializzo la tabella
Call InitTabella(atitoli,2,"center",1.5,5,"arial")
ColoreTesto(0)
For h = 1 To 10
  ruote(h) = h
Next
colonne = SviluppoIntegrale(ruote,classe)
For k = 1 To UBound(colonne)
  scolonna = ""
  Call Messaggio(" elaboro sviluppo  " & des1)
  If ScriptInterrotto Then Exit For
  Call AvanzamentoElab(1,UBound(colonne),k)
  ReDim ar(classe)
  For j = 1 To classe
   scolonna = scolonna & SiglaRuota(colonne(k,j)) & " "
   ar(j) = colonne(k,j)
  Next
  aretritardi = ""
  Call StatisticaFormazione(numeri,ar,s,ritardo,ritardomax,incrritmax,frequenza)
  Call ElencoRitardi(numeri,ar,s,EstrazioneIni,EstrazioneFin,aretritardi,aretidestr)
  y = UBound(aretritardi)
  avalori(1) = StringaNumeri(numeri)
  avalori(2) = " " & scolonna & " "
  avalori(3) = ritardo
  avalori(4) = ritardomax
  avalori(5) = incrritmax
  avalori(6) = frequenza
  If y >= 2 Then avalori(7) = aretritardi(y - 1) Else avalori(7) = 0 End If
  If y >= 3 Then avalori(8) = aretritardi(y - 2) Else avalori(8) = 0 End If
  If y >= 4 Then avalori(9) = aretritardi(y - 3) Else avalori(9) = 0 End If
  Call AddRigaTabella(avalori,Bianco_,"left",1)
  Call SetColoreCella(2,RGB(254,249,180),vbBlack)
  Call SetColoreCella(3,RGB(238,213,111),vbBlue)
  If avalori(3) >= avalori(4) Then
   Call SetColoreCella(3,RGB(250,137,131),vbBlue)
  End If
  ct = ct + 1
  If s <= 3 Then
   Call OrdinaMatrice(aretritardi,- 1)
   For q = 1 To 5
    ct2 = ct2 + 1
    max(ct2) = aretritardi(q)
   Next
  End If
Next
Call Messaggio(" creazione tabella e ordinamento :    Attendere  ")
CreaTabella(ord)
Call OrdinaMatrice(max,- 1)
Scrivi " 1°ritardo max..." & max(1)
Scrivi " 2°ritardo max..." & max(2)
Scrivi " 3°ritardo max..." & max(3)
Scrivi " 4°ritardo max..." & max(4)
Scrivi " 5°ritardo max..." & max(5)
Scrivi " "
Scrivi " totale combinazioni elaborate.." & ct,1
End Sub

Giulio LG · 22 Ottobre 2012

QuadrAmbi Sincroni Multipli con CG ( Autore Rubino )

QuadrAmbi Sincroni Multipli con CG ( Autore Rubino )

Codice:

Option Explicit
Sub Main
 Dim ru,n,fine,inizio,ne,listaestratti,ritco,s,g,rita,ritx,ritamax,freq,last,estric,U,oo,o,ox,cth,rtt1b,rtt2b,aRetRitardi,aRetIdEstr,ew
 Dim aa,bb,a,b,ambo,col,col2,ct,Ritardo,RitardoA,RitardoMax,Frequenza,sRetGruppiAnalizz,casi,casi2,q,k,ruot,RetEsito,RetColpi,RetEstratti,RetIdEstr,aRetRuote
 Dim max41,max31,max21,max11,aruota(1)
 ne = CInt(InputBox("Estrazione n.",,EstrazioneFin))
 fine = ne
 inizio = 3590
 last = EstrazioneFin
 ReDim atitoli(16)
 ReDim avalori(16)
 ' preimposto i titoli delle colonne
 atitoli(1) = " Estr.n. - data "
 atitoli(2) = "  RUOTA    "
 atitoli(3) = " A   m   b   o "
 atitoli(4) = " "
 atitoli(5) = " n.Ambi Capog."
 atitoli(6) = " "
 atitoli(7) = "  1 x 1 "
 atitoli(8) = "  2 x 1 "
 atitoli(9) = "  3 x 1 "
 atitoli(10) = "  4 x 1 "
 atitoli(15) = " Gruppo RCA"
 atitoli(16) = " Gruppo RS "
 ' ' inizializzo la tabella
 Call InitTabella(atitoli,2,"center",1.80,5,"Arial")
 '----------------------------------------------------------------------
 '''' trova numeri ripetuti nell'estrazione
 Call NumeriRipetutiRilevatiE(ne,VetRitornoN,VetRitornoQ)
 Dim VetRitornoN,VetRitornoQ
 '----------------------------------------------------------------------
 '''elabora le cinquine estratte nelle 12 ruote
 For ru = 1 To 12
  If ru <> 11 Then
   listaestratti = StringaEstratti(ne,ru,".")
   Scrivi ne & "    " & SiglaRuota(ru) & " " & listaestratti,1
  End If
 Next
 ''----------------------------------------------------------------------
 '''elabora le 12 ruote (solo la base dei numeri ripetuti)
 For s = 1 To UBound(VetRitornoN)
  For ru = 1 To 12
   If ru <> 11 Then
    listaestratti = StringaEstratti(ne,ru,".")
    ReDim aV2(5)
    Call SplitByChar(listaestratti,".",aV2)
    avalori(1) = ne & " - " & DataEstrazione(ne)
    avalori(2) = SiglaRuota(ru)
    'colore
    If dispari(s) = True Then
     col = RGB(249,254,156)
    Else
     col = RGB(255,255,244)
    End If
    '''ricerca ritardi 4x1 3x1 2x1 1x1
    ReDim qua(4)
    ox = 0
    For oo = 1 To 4
     qua(oo) = 0
    Next
    ''''5 ambi capogioco
    For a = 0 To 4
     aa = aV2(a)
     ct = 0
     ambo = ""
     casi = 0
     casi2 = 0
     ReDim max(4),maxco(4)
     For b = 0 To 4
      bb = aV2(b)
      If aa <> bb Then
       ambo = ambo & aa & " " & bb & " - "
       estric = ne + 1
       ReDim an(2)
       an(1) = aa
       an(2) = bb
       aruota(1) = ru
       '''ricerca ritardo attuale minimo del gruppo dei 4 ambi con capogioco
       If Int(aa) = VetRitornoN(s) Then
        ReDim an(2)
        an(1) = aa
        an(2) = bb
        '''cambio ruota in 11 perchè per questa istruzione (NAzionale è = a 11 e non a 12
        If ru = 12 Then ruot = 11 Else ruot = ru End If
        Call AddNumeriToGruppoStatistico(an,ruot)
        Call OrdinaMatrice(an,- 1)
        Call VerificaEsito(an,aruota,estric,2,,,RetEsito,RetColpi,RetEstratti,RetIdEstr,aRetRuote)
        If RetEsito = "Ambo" Then
         ox = ox + 1
         qua(ox) = RetIdEstr
        Else
         ox = ox + 1
         qua(ox) = EstrazioneFin
        End If
       End If
      End If
      avalori(3) = ambo
      avalori(6) = " "
     Next
     ''''''''''elabora solo numeri isocroni
     If Int(aa) = VetRitornoN(s) Then
      Call OrdinaMatrice(qua,- 1)
      If qua(1) > 0 Then max41 = qua(1) - ne End If
      If qua(2) > 0 Then max31 = qua(2) - ne End If
      If qua(3) > 0 Then max21 = qua(3) - ne End If
      If qua(4) > 0 Then max11 = qua(4) - ne End If
      avalori(10) = max11
      avalori(9) = max21
      avalori(8) = max31
      avalori(7) = max41
      avalori(15) = " "
      avalori(16) = " "
      For q = 7 To 10
       If avalori(q) = EstrazioneFin - ne Then
        ct = ct + 1
       End If
      Next
      If ct = 0 Then avalori(5) = ct & " Chiusa " Else avalori(5) = ct End If
      Call AddRigaTabella(avalori,col,"center",1)
      Call SetColoreCella(4,RGB(55,2,155),vbBlack)
      Call SetColoreCella(6,RGB(55,2,155),vbBlack)
      Call SetColoreCella(11,RGB(219,219,219),vbBlack)
      Call SetColoreCella(12,RGB(219,219,219),vbBlack)
      Call SetColoreCella(13,RGB(219,219,219),vbBlack)
      Call SetColoreCella(14,RGB(219,219,219),vbBlack)
      For q = 7 To 10
       If avalori(q) = EstrazioneFin - ne Then
        Call SetColoreCella(Int(q),RGB(239,113,52),vbWhite)
        Call SetColoreCella(5,RGB(239,113,52),vbWhite)
       End If
      Next
     End If
    Next
   End If
  Next
  Call Messaggio(" Richiesto Estrazione n. " & ne & "   al  " & ne & "   n.Ripetuto  " & VetRitornoN(s) & "..." & NomeRuota(ru))
  If ScriptInterrotto Then Exit For
  Call AvanzamentoElab(1,10,ru)
  For g = 1 To 14
   avalori(g) = " "
  Next
  Call StatisticaGruppoFormazioni(2,Ritardo,RitardoMax,Frequenza,sRetGruppiAnalizz)
  rita = Ritardo
  ritx = RitardoMax
  avalori(3) = " G r u p p o -----> "
  avalori(15) = rita
  avalori(16) = ritx
  Call AddRigaTabella(avalori,Verde_,"center",1)
  If avalori(15) >= avalori(16) Then
   Call SetColoreCella(15,RGB(224,31,20),vbWhite)
   Call SetColoreCella(16,RGB(224,31,20),vbWhite)
  End If
 Next
 CreaTabella
End Sub

Giulio LG · 9 Novembre 2012

Sviluppo CombinazioniNumeri ( Autore Rubino )

Sviluppo CombinazioniNumeri ( Autore Rubino )

Codice:

Sub Main
 Dim Colonne
 ReDim numeri(10),nm(10)
 Dim classe
 Dim sColonna
 Dim s,k,ct,j,y,u,rita,rt1,rt2,Ritardo,RitardoMax,IncrRitMax,Frequenza,aRetRitardi,aRetIdEstr,des1,des2,qt,nn,nn1,num
 rt1 = CInt(InputBox("Ruota di Elaborazione ",,1))
 Do While qt = ""
  num = InputBox("Sviluppo Numeri classe (max = 10)",,"10.20.30.40.50.60.70.80.90")
  ReDim aV2(0)
  Call SplitByChar(num,".",aV2)
  If UBound(aV2) >= 11 Then
   MsgBox("Max possibile (10 Numeri)")
   qt = ""
  Else
   For nn = 0 To UBound(aV2)
    nn1 = nn1 + 1
    numeri(nn1) = aV2(nn)
   Next
   Exit Do
  End If
 Loop
 Do While classe = ""
  classe = InputBox("Sviluppo In classe (max decina = 10)",,3)
  If classe >= 11 Then
   MsgBox("Max possibile 10  Sviluppo = Decina ")
   classe = ""
  Else
   Exit Do
  End If
 Loop
 Do While s = ""
  s = InputBox("Inserire sorte 1,2,3,4,5 ",,2)
  If s >= 6 Then
   MsgBox("Max possibile (5) = cinquina ")
   s = ""
  Else
   Exit Do
  End If
 Loop
 ColoreTesto(1)
 des1 = " Comb.di Numeri " & classe
 If s = 1 Then des2 = "  Ambata  "
 If s = 2 Then des2 = "  Ambo    "
 If s = 3 Then des2 = "  Terno   "
 If s = 4 Then des2 = "  Quaterna"
 If s = 5 Then des2 = "  Cinquina"
 Scrivi " Numeri richiesti o inseriti............." & StringaNumeri(numeri),1
 Scrivi " Sviluppo della combinazione in classe..." & classe & " " & des1,1
 Scrivi " Ritardi calcola per la sorte di........." & s & " " & des2,1
 Scrivi ""
 Scrivi "------b-y------R-u-b-i-n-o-----------------",1
 Scrivi ""
 ReDim atitoli(11)
 ReDim avalori(11)
 ' preimposto i titoli delle colonne
 atitoli(1) = "   N u m e r i   "
 atitoli(2) = "   Ruota   "
 atitoli(3) = "   RCA   "
 atitoli(4) = "   RS   "
 atitoli(5) = "  IncrCron  "
 atitoli(6) = "   Freq   "
 atitoli(7) = "   Rp1   "
 atitoli(8) = "   Rp2   "
 atitoli(9) = "   Rp3   "
 atitoli(10) = "   Rp4   "
 atitoli(11) = "   Rp5   "
 ' ' inizializzo la tabella
 Call InitTabella(atitoli,2,"center",1.5,5,"Arial")
 ColoreTesto(0)
 Colonne = SviluppoIntegrale(numeri,classe)
 For k = 1 To UBound(Colonne)
  sColonna = ""
  Call Messaggio(" Elaboro Sviluppo  " & des1)
  If ScriptInterrotto Then Exit For
  Call AvanzamentoElab(1,UBound(Colonne),k)
  For j = 1 To classe
   sColonna = sColonna & Format2(Colonne(k,j)) & " "
   nm(j) = Colonne(k,j)
  Next
  ReDim ar(1)
  ar(1) = rt1
  Call StatisticaFormazione(nm,ar,s,Ritardo,RitardoMax,IncrRitMax,Frequenza)
  Call ElencoRitardi(nm,ar,s,EstrazioneIni,EstrazioneFin,aRetRitardi,aRetIdEstr)
  y = UBound(aRetRitardi)
  ct = ct + 1
  avalori(1) = sColonna
  avalori(2) = SiglaRuota(rt1) & " " & SiglaRuota(rt2)
  avalori(3) = Ritardo
  avalori(4) = RitardoMax
  avalori(5) = IncrRitMax
  avalori(6) = Frequenza
  If y >= 2 Then avalori(7) = aRetRitardi(y - 1) Else avalori(7) = 0 End If
  If y >= 3 Then avalori(8) = aRetRitardi(y - 2) Else avalori(8) = 0 End If
  If y >= 4 Then avalori(9) = aRetRitardi(y - 3) Else avalori(9) = 0 End If
  If y >= 5 Then avalori(10) = aRetRitardi(y - 4) Else avalori(10) = 0 End If
  If y >= 6 Then avalori(11) = aRetRitardi(y - 5) Else avalori(11) = 0 End If
  Call AddRigaTabella(avalori,Bianco_,"center",1)
  Call SetColoreCella(2,RGB(254,249,180),vbBlack)
  Call SetColoreCella(3,RGB(238,213,111),vbBlue)
 Next
 Call Messaggio(" Creazione Tabella e ordinamento :    ATTENDERE  ")
 CreaTabella(3)
 Scrivi " Totale combinazioni elaborate.." & ct,1
End Sub

Codice:

Sub Main
 Dim Colonne
 ReDim numeri(10),nm(10)
 Dim classe
 Dim sColonna
 Dim s,k,ct,j,y,u,rita,rt1,rt2,Ritardo,RitardoMax,IncrRitMax,Frequenza,aRetRitardi,aRetIdEstr,des1,des2,qt,nn,nn1,num
 rt1 = CInt(InputBox("Ruota di Elaborazione ",,8))
 Do While qt = ""
  num = InputBox("Sviluppo Numeri classe (max = 10)",,"10.20.30.40.50.60.70.80.90")
  ReDim aV2(0)
  Call SplitByChar(num,".",aV2)
  If UBound(aV2) >= 11 Then
   MsgBox("Max possibile (10 Numeri)")
   qt = ""
  Else
   For nn = 0 To UBound(aV2)
    nn1 = nn1 + 1
    numeri(nn1) = aV2(nn)
   Next
   Exit Do
  End If
 Loop
 Do While classe = ""
  classe = InputBox("Sviluppo In classe (max decina = 10)",,9)
  If classe >= 11 Then
   MsgBox("Max possibile 10  Sviluppo = Decina ")
   classe = ""
  Else
   Exit Do
  End If
 Loop
 Do While s = ""
  s = InputBox("Inserire sorte 1,2,3,4,5 ",,2)
  If s >= 6 Then
   MsgBox("Max possibile (5) = cinquina ")
   s = ""
  Else
   Exit Do
  End If
 Loop
 ColoreTesto(1)
 des1 = " Comb.di Numeri " & classe
 If s = 1 Then des2 = "  Ambata  "
 If s = 2 Then des2 = "  Ambo    "
 If s = 3 Then des2 = "  Terno   "
 If s = 4 Then des2 = "  Quaterna"
 If s = 5 Then des2 = "  Cinquina"
 Scrivi " Numeri richiesti o inseriti............." & StringaNumeri(numeri),1
 Scrivi " Sviluppo della combinazione in classe..." & classe & " " & des1,1
 Scrivi " Ritardi calcola per la sorte di........." & s & " " & des2,1
 Scrivi ""
 Scrivi "------b-y------R-u-b-i-n-o-----------------",1
 Scrivi ""
 ReDim atitoli(21)
 ReDim avalori(21)
 ' preimposto i titoli delle colonne
 atitoli(1) = "N u m e r i"
 atitoli(2) = "Ruota"
 atitoli(3) = "RCA"
 atitoli(4) = "RS"
 atitoli(5) = "IncrCr"
 atitoli(6) = "  Freq  "
 atitoli(7) = "Rp1"
 atitoli(8) = "Rp2"
 atitoli(9) = "Rp3"
 atitoli(10) = "Rp4"
 atitoli(11) = "Rp5"
 atitoli(12) = "Rp6"
 atitoli(13) = "Rp7"
 atitoli(14) = "Rp8"
 atitoli(15) = "Rp9"
 atitoli(16) = "Rp10"
 atitoli(17) = "Rp11"
 atitoli(18) = "Rp12"
 atitoli(19) = "Rp13"
 atitoli(20) = "Rp14"
 atitoli(21) = "Rp15"
 ' ' inizializzo la tabella
 Call InitTabella(atitoli,2,"center",1.5,5,"Arial")
 ColoreTesto(0)
 Colonne = SviluppoIntegrale(numeri,classe)
 For k = 1 To UBound(Colonne)
  sColonna = ""
  Call Messaggio(" Elaboro Sviluppo  " & des1)
  If ScriptInterrotto Then Exit For
  Call AvanzamentoElab(1,UBound(Colonne),k)
  For j = 1 To classe
   sColonna = sColonna & Format2(Colonne(k,j)) & " "
   nm(j) = Colonne(k,j)
  Next
  ReDim ar(1)
  ar(1) = rt1
  Call StatisticaFormazione(nm,ar,s,Ritardo,RitardoMax,IncrRitMax,Frequenza)
  Call ElencoRitardi(nm,ar,s,EstrazioneIni,EstrazioneFin,aRetRitardi,aRetIdEstr)
  y = UBound(aRetRitardi)
  ct = ct + 1
  avalori(1) = sColonna
  avalori(2) = SiglaRuota(rt1) & " " & SiglaRuota(rt2)
  avalori(3) = Ritardo
  avalori(4) = RitardoMax
  avalori(5) = IncrRitMax
  avalori(6) = Frequenza
  If y >= 2 Then avalori(7) = aRetRitardi(y - 1) Else avalori(7) = 0 End If
  If y >= 3 Then avalori(8) = aRetRitardi(y - 2) Else avalori(8) = 0 End If
  If y >= 4 Then avalori(9) = aRetRitardi(y - 3) Else avalori(9) = 0 End If
  If y >= 5 Then avalori(10) = aRetRitardi(y - 4) Else avalori(10) = 0 End If
  If y >= 6 Then avalori(11) = aRetRitardi(y - 5) Else avalori(11) = 0 End If
  If y >= 7 Then avalori(12) = aRetRitardi(y - 6) Else avalori(12) = 0 End If
  If y >= 8 Then avalori(13) = aRetRitardi(y - 7) Else avalori(13) = 0 End If
  If y >= 9 Then avalori(14) = aRetRitardi(y - 8) Else avalori(14) = 0 End If
  If y >= 10 Then avalori(15) = aRetRitardi(y - 9) Else avalori(15) = 0 End If
  If y >= 11 Then avalori(16) = aRetRitardi(y - 10) Else avalori(16) = 0 End If
  If y >= 12 Then avalori(17) = aRetRitardi(y - 11) Else avalori(17) = 0 End If
  If y >= 13 Then avalori(18) = aRetRitardi(y - 12) Else avalori(18) = 0 End If
  If y >= 14 Then avalori(19) = aRetRitardi(y - 13) Else avalori(19) = 0 End If
  If y >= 15 Then avalori(20) = aRetRitardi(y - 14) Else avalori(20) = 0 End If
  If y >= 16 Then avalori(21) = aRetRitardi(y - 15) Else avalori(21) = 0 End If
  Call AddRigaTabella(avalori,Bianco_,"center",1)
  Call SetColoreCella(2,RGB(254,249,180),vbBlack)
  Call SetColoreCella(3,RGB(238,213,111),vbBlue)
 Next
 Call Messaggio(" Creazione Tabella e ordinamento :    ATTENDERE  ")
 CreaTabella(3)
 Scrivi " Totale combinazioni elaborate.." & ct,1
End Sub

Giulio LG · 25 Novembre 2012

INTERCAMBIABILE ( AUTORE Mike58 )

INTERCAMBIABILE ( AUTORE Mike58 )

Codice:

Sub Main
 Dim a(15)'NUMERO DA MODIFICARE IN BASE ALLE COMBINAZIONI INSERITE
 Dim Ru(1)
 Dim k
 Dim nu
 ReDim aruote(12)
 Scrivi "( Radicali ) Ruota di... ",1,0,4
 If ScegliRuote(aruote) > 0 Then
  For k = 1 To UBound(aruote)
   If aruote(k) > 0 Then
    Scrivi " " & NomeRuota(aruote(k)),1,0,3
   End If
  Next
 End If
 'rt = CInt(InputBox("Quale ruota analizzare ",Ruota,4))
 'Ru(1) = rt
 Dim posta(2)
 posta(1) = 1
 posta(2) = 1
 Fin = EstrazioneFin
 Ini = EstrazioneIni
 Scrivi NomeRuota(Ru(1)),1,0
 Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)
 ReDim atitoli(33)
 atitoli(1) = "TOT."
 'atitoli(2) = " esito "
 atitoli(3) = "Combinazioni"
 'atitoli(4) = " esito "
 'atitoli(5) = " estratti "
 atitoli(6) = "RCA1"
 atitoli(7) = "RCA2"
 atitoli(8) = "RCA3"
 atitoli(9) = "RCA4"
 atitoli(10) = "RCA5"
 'atitoli(11) = "  esito  "
 'atitoli(12) = "  estratti  "
 atitoli(13) = "RS1"
 atitoli(14) = "RS2"
 atitoli(15) = "RS3"
 atitoli(16) = "RS4"
 atitoli(17) = "RS5"
 'atitoli(18) = "  Esito  "
 'atitoli(19) = "  Estratti  "
 atitoli(20) = "FRE1"
 atitoli(21) = "FRE2"
 atitoli(22) = "FRE3"
 atitoli(23) = "FRE4"
 atitoli(24) = "FRE5"
 'atitoli(25) = " esito "
 'atitoli(26) = " estratti "
 atitoli(27) = "RD1"
 atitoli(28) = "RD2"
 atitoli(29) = "RD3"
 atitoli(30) = "RD4"
 atitoli(31) = "RD5"
 'atitoli(32) = " esito "
 'atitoli(33) = " estratti "
 Call InitTabella(atitoli,1,,2,5)
 '-------------inserimento combinazioni --------------------------
 a(01) = "01-10-11-19"
 a(02) = "02-20-22-29"
 a(03) = "03-30-33-39"
 a(04) = "04-40-44-49"
 a(05) = "05-50-55-59"
 a(06) = "06-60-66-69"
 a(07) = "07-70-77-79"
 a(08) = "08-80-88-89"
 a(09) = "01-10-11-19-02-20-22-29"
 a(10) = "01-10-11-19-03-30-33-39"
 a(11) = "01-10-11-19-04-40-44-49"
 a(12) = "01-10-11-19-05-50-55-59"
 a(13) = "01-10-11-19-06-60-66-69"
 a(14) = "01-10-11-19-07-70-77-79"
 a(15) = "01-10-11-19-08-80-88-89"
 'a(10) = "09-49-80"
 'a(11) = "15-34-90"
 'a(12) = "15-32-90"
 'a(13) = "14-15-90"
 'a(14) = "14-32-34"
 'a(15) = "15-67-90"
 'a(16) = "14-15-32"
 'a(17) = "14-32-90"
 'a(18) = "15-87-90"
 'a(19) = "05-35-49"
 'a(20) = "15-32-34"
 '----------------- fine combinazioni ------------------------------
 For N = 1 To UBound(a)
  nu = Split("0-" &(a(n)),"-")
  sr1 = SerieRitardo(Ini,fin,nu,aruote,1)', 1 scrive il ritardo dell'estratto
  sr2 = SerieRitardo(Ini,fin,nu,aruote,2)
  sr3 = SerieRitardo(Ini,fin,nu,aruote,3)
  sr4 = SerieRitardo(Ini,fin,nu,aruote,4)
  sr5 = SerieRitardo(Ini,fin,nu,aruote,5)
  'sr6 = SerieRitardo(Ini,fin,nu,aruote,6)
  'Tot = Tot + SR
  st1 = SerieStorico(Ini,fin,nu,aruote,1)
  st2 = SerieStorico(Ini,fin,nu,aruote,2)
  st3 = SerieStorico(Ini,fin,nu,aruote,3)
  st4 = SerieStorico(Ini,fin,nu,aruote,4)
  st5 = SerieStorico(Ini,fin,nu,aruote,5)
  'st6 = SerieRitardo(Ini,fin,nu,aruote,6)
  'Tot = Tot + ST
  sf1 = SerieFreq(Ini,Fin,nu,aruote,1)
  sf2 = SerieFreq(Ini,Fin,nu,aruote,2)
  sf3 = SerieFreq(Ini,Fin,nu,aruote,3)
  sf4 = SerieFreq(Ini,Fin,nu,aruote,4)
  sf5 = SerieFreq(Ini,fin,nu,aruote,5)
  'sf = serieFreq(Ini,fin,nu,aruote,6)
  'Tot = Tot + SF
  'SF1 = SerieFreq(fin - 18,Fin,Nu,aruote,1)
  'SF2 = SerieFreq(fin - 18,Fin,Nu,aruote,1)
  'SF3 = SerieFreq(fin - 18,Fin,Nu,aruote,1)
  'SF4 = SerieFreq(fin - 18,Fin,Nu,aruote,1)
  'sf5 = seriefreq(fin - 18,fin,nu,aruote,1)
  'sf6 = seriefreq(fin - 18,fin,nu,aruote,1)
  'Tot = Tot + SF1
  Call VerificaEsito(nu,aruote,fin,2,1,,retesito,,retestratti)
  ReDim avalori(33)
  avalori(1) = n
  'avalori(2) = " esito "
  avalori(3) = StringaNumeri(nu)
  'avalori(4) = " esito "
  'avalori(5) = " estratti "
  avalori(6) = sr1
  avalori(7) = sr2
  avalori(8) = sr3
  avalori(9) = sr4
  avalori(10) = sr5
  'avalori(11) = "  esito  "
  'avalori(12) = "  estratti  "
  avalori(13) = st1
  avalori(14) = st2
  avalori(15) = st3
  avalori(16) = st4
  avalori(17) = st5
  'avalori(18) = "  retesito  "
  'avalori(19) = "  retestratti  "
  avalori(20) = sf1
  avalori(21) = sf2
  avalori(22) = sf3
  avalori(23) = sf4
  avalori(24) = sf5
  'avalori(25) = " esito "
  'avalori(26) = " estratti "
  avalori(27) = RitDiPos(nu,1,aruote)
  avalori(28) = RitDiPos(nu,2,aruote)
  avalori(29) = RitDiPos(nu,3,aruote)
  avalori(30) = RitDiPos(nu,4,aruote)
  avalori(31) = RitDiPos(nu,5,aruote)
  'avalori(32) = " esito "
  'avalori(33) = " estratto "
  Call AddRigaTabella(avalori)
  ImpostaGiocata n,nu,aruote,posta,18
  '---------colora colonne---------------------
  ' 1 esempio ------
  Call SetColoreCella(1,,vbBlue)
  Call SetColoreCella(3,,vbRed)' colora la colonna 2 sfondo ciano scritta gialla
  Call SetColoreCella(2,3,4)
  Call SetColoreCella(4,3,4)
  Call SetColoreCella(5,3,4)
  Call SetColoreCella(11,3,4)
  Call SetColoreCella(12,3,4)
  Call SetColoreCella(18,3,4)
  Call SetColoreCella(19,3,4)
  Call SetColoreCella(25,3,4)
  Call SetColoreCella(26,3,4)
  Call SetColoreCella(32,3,4)
  Call SetColoreCella(33,3,4)
  Call SetColoreCella(27,RGB(254,249,180),vbBlue)
  Call SetColoreCella(28,RGB(254,249,180),vbBlue)
  Call SetColoreCella(29,RGB(254,249,180),vbBlue)
  Call SetColoreCella(30,RGB(254,249,180),vbBlue)
  Call SetColoreCella(31,RGB(254,249,180),vbBlue)
  '2 esempio ----------------------------------
  ' colora la colonna 1 sfondo default bianco  scritta verde
  Call SetColoreCella(6,4,0)
  Call SetColoreCella(7,0,4)
  Call SetColoreCella(8,4,0)
  Call SetColoreCella(9,0,4)
  Call SetColoreCella(10,4,0)
if avalori(6) > 5 then call setcolorecella(6,vbred) ' se il valore della cella 6 > 5 colora solo il valore > 5 della cella 6.
 Next
 Scrivi
 Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1
 Scrivi
 Call CreaTabella()
 Scrivi"------------------------------------------------ Dettaglio ultime 18 giocate ---------------------------------------------"
 Gioca(fin - 18),,,1
 ScriviResoconto(True)
 'PicClear
 Call PicStampaTesto(1,10,"Listed by Mike58 ",,1,1,,11,vbRed)
 PicEsegui
End Sub
Function RitDiPos(nu,pos,aruote)
 ReDim apos(5)
 apos(pos) = True
 RitDiPos = RitardoCombinazione(aruote,nu,1,0,apos)
End Function

Codice:

Sub Main
 Dim a(5)'NUMERO DA MODIFICARE IN BASE ALLE COMBINAZIONI INSERITE
 Dim Ru(1)
 Dim k
 Dim nu
 ReDim aruote(12)
 Scrivi "( 90numeri ) Ruota di... ",1,0,4
 If ScegliRuote(aruote) > 0 Then
  For k = 1 To UBound(aruote)
   If aruote(k) > 0 Then
    Scrivi " " & NomeRuota(aruote(k)),1,0,3
   End If
  Next
 End If
 Dim posta(2)
 posta(1) = 1
 posta(2) = 1
 Fin = EstrazioneFin
 Ini = EstrazioneIni
 Scrivi NomeRuota(Ru(1)),1,0
 Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)
 ReDim atitoli(25)
 atitoli(1) = "Pezzi"
 'atitoli(2) = " esito "
 atitoli(3) = " 90num."
 'atitoli(4) = " esito "
 'atitoli(5) = " estratti "
 atitoli(6) = "RCA"
 'atitoli(7) = "  esito  "
 atitoli(8) = "RS"
 'atitoli(9) = "  Esito  "
 atitoli(10) = "FRE"
 'atitoli(11) = " esito "
 'atitoli(12) = " estratti "
 atitoli(13) = "RD1"
 atitoli(14) = "RD2"
 atitoli(15) = "RD3"
 atitoli(16) = "RD4"
 atitoli(17) = "RD5"
 'atitoli(18) = " esito "
 'atitoli(19) = " estratti "
 atitoli(20) = "RP1"
 atitoli(21) = "RP2"
 atitoli(22) = "RP3"
 atitoli(23) = "RP4"
 atitoli(24) = "RP5"
 atitoli(25) = "RP6"
 Call InitTabella(atitoli,1,,2,5)
 a(01) = "01"
 a(02) = "02"
 a(03) = "03"
 a(04) = "04"
 a(05) = "05"
 For N = 1 To UBound(a)
  nu = Split("0-" &(a(n)),"-")
  sr1 = SerieRitardo(Ini,fin,nu,aruote,1)', 1 scrive il ritardo dell'estratto
  'sr6 = SerieRitardo(Ini,fin,nu,aruote,6)
  'Tot = Tot + SR
  st1 = SerieStorico(Ini,fin,nu,aruote,1)
  'st6 = SerieRitardo(Ini,fin,nu,aruote,6)
  'Tot = Tot + ST
  sf1 = SerieFreq(Ini,Fin,nu,aruote,1)
  'sf = serieFreq(Ini,fin,nu,aruote,6)
  'Tot = Tot + SF
  Call VerificaEsito(nu,aruote,fin,2,1,,retesito,,retestratti)
  ReDim avalori(25)
  avalori(1) = n
  'avalori(2) = " esito "
  avalori(3) = StringaNumeri(nu)
  'avalori(4) = " esito "
  'avalori(5) = " estratti "
  avalori(6) = sr1
  'avalori(7) = "  esito  "
  avalori(8) = st1
  'avalori(9) = "  retesito  "
  avalori(10) = sf1
  'avalori(11) = " esito "
  'avalori(12) = " estratti "
  avalori(13) = RitDiPos(nu,1,aruote)
  avalori(14) = RitDiPos(nu,2,aruote)
  avalori(15) = RitDiPos(nu,3,aruote)
  avalori(16) = RitDiPos(nu,4,aruote)
  avalori(17) = RitDiPos(nu,5,aruote)
  'avalori(18) = " esito "
  'avalori(19) = " estratto "
  '***********calcolo ritardi precedenti****************************
  ReDim rp(7) 'Numero da modificare in base hai Ritardi Prec. inseriti.
  Inizio = EstrazioneIni
  fine = EstrazioneFin
  'somrit = 0
  For z = 1 To 7 'Numero da modificare in base hai Ritardi Prec. inseriti.
   rp(z) = SerieRitardo(Inizio,fine,nu,aruote,1)
   fine = fine -(rp(z) + 1)
   'somrit = somrit + rp(z)
   'Medrit = Int(somrit/z)
  Next
  ' il primo rp(1) = ritardo corrente
  avalori(20) = rp(2) ' scrive 1 ritardo precedente
  avalori(21) = rp(3) ' scrive il 2 ritardo prec.
  avalori(22) = rp(4)
  avalori(23) = rp(5)
  avalori(24) = rp(6)
  avalori(25) = rp(7)
  ' si possono scrivere fino a quanti ritardi del max for-next
  '********fine calcolo****************************************************
  Call AddRigaTabella(avalori)
  ImpostaGiocata n,nu,aruote,posta,18
  '---------colora colonne---------------------
  ' 1 esempio ------
  Call SetColoreCella(1,,vbBlue)
  Call SetColoreCella(3,,vbRed)' colora la colonna 2 sfondo ciano scritta gialla
  Call SetColoreCella(2,3,4)
  Call SetColoreCella(4,3,4)
  Call SetColoreCella(5,3,4)
  Call SetColoreCella(7,0,4)
  Call SetColoreCella(9,0,4)
  Call SetColoreCella(11,3,4)
  Call SetColoreCella(12,3,4)
  Call SetColoreCella(18,3,4)
  Call SetColoreCella(19,3,4)
  Call SetColoreCella(13,RGB(254,249,180),vbBlue)
  Call SetColoreCella(14,RGB(254,249,180),vbBlue)
  Call SetColoreCella(15,RGB(254,249,180),vbBlue)
  Call SetColoreCella(16,RGB(254,249,180),vbBlue)
  Call SetColoreCella(17,RGB(254,249,180),vbBlue)
  '2 esempio ----------------------------------
  ' colora la colonna 1 sfondo default bianco  scritta verde
  Call SetColoreCella(6,4,0)
  Call SetColoreCella(8,4,0)
  Call SetColoreCella(10,4,0)
if avalori(6) > 5 then call setcolorecella(6,vbred) ' se il valore della cella 6 > 5 colora solo il valore > 5 della cella 6.
 Next
 Scrivi
 Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1
 Scrivi
 Call CreaTabella()
 Scrivi"------------------------------------------------ Dettaglio ultime 18 giocate ---------------------------------------------"
 Gioca(fin - 18),,,1
 ScriviResoconto(True)
 'PicClear
 Call PicStampaTesto(1,10,"Listed by Mike58 ",,1,1,,11,vbRed)
 PicEsegui
End Sub
Function RitDiPos(nu,pos,aruote)
 ReDim apos(5)
 apos(pos) = True
 RitDiPos = RitardoCombinazione(aruote,nu,1,0,apos)
End Function

Codice:

Sub Main
 Dim a(8)'NUMERO DA MODIFICARE IN BASE ALLE COMBINAZIONI INSERITE__TABELLE__
 Dim Ru(1)
 Dim k
 Dim nu
 ReDim aruote(1)
 righe = InputBox("Quante righe vuoi vedere ",,6)
 Fin = EstrazioneFin
 Ini = EstrazioneIni
 Scrivi "Quartine Radicali ",1,- 1,4
 Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1
 Scrivi "dalla data inizio... " & DataEstrazione(Ini) & " alla data fine... " & DataEstrazione(Fin),1
 'If ScegliRuote(aruote) > 0 Then
 For k = 1 To 12
  'If aruote(k) > 0 Then Scrivi " " & NomeRuota(aruote(k)),1,0,4
  'End If
  Ru(1) = k
  nstart = Timer
  Scrivi "" & NomeRuota(Ru(1)),1,- 1,7
  ReDim atitoli(21)
  atitoli(01) = " 8 "
  atitoli(02) = " COMBINAZIONI "
  atitoli(03) = "RA1 "
  atitoli(04) = "RA2 "
  atitoli(05) = "RA3 "
  atitoli(06) = "RS1 "
  atitoli(07) = "RS2 "
  atitoli(08) = "RS3 "
  atitoli(09) = "SF1 "
  atitoli(10) = "SF2 "
  atitoli(11) = "SF3 "
  atitoli(12) = "RD1 "
  atitoli(13) = "RD2 "
  atitoli(14) = "RD3 "
  atitoli(15) = "RD4 "
  atitoli(16) = "RD5 "
  atitoli(17) = "2Rp1"
  atitoli(18) = "2Rp2"
  atitoli(19) = "2Rp3"
  atitoli(20) = "2Rp4"
  atitoli(21) = "2Rp5"
  Call InitTabella(atitoli,0,,2,5)
  a(1) = "1-10-11-19"
  a(2) = "2-20-22-29"
  a(3) = "3-30-33-39"
  a(4) = "4-40-44-49"
  a(5) = "5-50-55-59"
  a(6) = "6-60-66-69"
  a(7) = "7-70-77-79"
  a(8) = "8-80-88-89"
  For N = 1 To UBound(a)
   nu = Split("0-" &(a(n)),"-")
   sr1 = SerieRitardoTurbo(Ini,fin,nu,Ru,1)', 1 scrive il ritardo dell'estratto
   sr2 = SerieRitardoTurbo(Ini,fin,nu,Ru,2)
   sr3 = SerieRitardoTurbo(Ini,fin,nu,Ru,3)
   'sr4 = SerieRitardoTurbo(Ini,fin,nu,aruote,4)
   'sr5 = SerieRitardoTurbo(Ini,fin,nu,aruote,5)
   st1 = SerieStoricoTurbo(Ini,fin,nu,Ru,1)
   st2 = SerieStoricoTurbo(Ini,fin,nu,Ru,2)
   st3 = SerieStoricoTurbo(Ini,fin,nu,Ru,3)
   'st4 = SerieStoricoTurbo(Ini,fin,nu,aruote,4)
   'st5 = SerieStoricoTurbo(Ini,fin,nu,aruote,5)
   sf1 = SerieFreqTurbo(Ini,Fin,nu,Ru,1)
   sf2 = SerieFreqTurbo(Ini,Fin,nu,Ru,2)
   sf3 = SerieFreqTurbo(Ini,Fin,nu,Ru,3)
   'sf4 = SerieFreqTurbo(Ini,Fin,nu,aruote,4)
   'sf5 = SerieFreqTurbo(Ini,fin,nu,aruote,5)
   Call VerificaEsitoTurbo(nu,Ru,fin,2,1,,retesito,,retestratti)
   ReDim avalori(21)
   avalori(01) = n
   avalori(02) = StringaNumeri(nu)
   avalori(03) = sr1
   avalori(04) = sr2
   avalori(05) = sr3
   avalori(06) = st1
   avalori(07) = st2
   avalori(08) = st3
   avalori(09) = sf1
   avalori(10) = sf2
   avalori(11) = sf3
   avalori(12) = RitDiPos(nu,1,Ru)
   avalori(13) = RitDiPos(nu,2,Ru)
   avalori(14) = RitDiPos(nu,3,Ru)
   avalori(15) = RitDiPos(nu,4,Ru)
   avalori(16) = RitDiPos(nu,5,Ru)
   ReDim rp(6) 'Numero da modificare in base hai Ritardi Prec. inseriti.
   Inizio = EstrazioneIni
   fine = EstrazioneFin
   'somrit = 0
   For z = 1 To 6 'Numero da modificare in base hai Ritardi Prec. inseriti.
    rp(z) = SerieRitardoTurbo(Inizio,fine,nu,Ru,2) '1 Rit.Prec ESTRATTO_2 AMBO_3 TERNO ....
    fine = fine -(rp(z) + 1)
    'somrit = somrit + rp(z)
    'Medrit = Int(somrit/z)
   Next
   'il Primo rp(1) = ritardo corrente
   avalori(17) = rp(2) ' scrive 1 ritardo precedente
   avalori(18) = rp(3)
   avalori(19) = rp(4)
   avalori(20) = rp(5)
   avalori(21) = rp(6)
   Call AddRigaTabella(avalori)
   Call SetColoreCella(1,,vbBlue)
   Call SetColoreCella(2,,vbRed)' colora la colonna 2 sfondo ciano scritta gialla
   Call SetColoreCella(3,4,0)
   Call SetColoreCella(4,4,0)
   Call SetColoreCella(5,4,0)
   Call SetColoreCella(12,RGB(224,31,20),vbWhite)
   Call SetColoreCella(13,RGB(224,31,20),vbWhite)
   Call SetColoreCella(14,RGB(224,31,20),vbWhite)
   Call SetColoreCella(15,RGB(224,31,20),vbWhite)
   Call SetColoreCella(16,RGB(224,31,20),vbWhite)
   If avalori(03) > 0020 Then Call SetColoreCella(03,2,vbWhite) 'RA
   If avalori(04) > 0100 Then Call SetColoreCella(04,3,0) 'RA
   If avalori(04) > 0500 Then Call SetColoreCella(04,2,vbWhite) 'RA
   If avalori(05) > 8500 Then Call SetColoreCella(05,2,vbWhite) 'RA
   If avalori(06) > 0045 Then Call SetColoreCella(06,2,vbWhite) 'RS
   If avalori(07) > 0600 Then Call SetColoreCella(07,2,vbWhite) 'RS
   If avalori(08) > 8500 Then Call SetColoreCella(08,2,vbWhite) 'RS
   If avalori(12) > 0100 Then Call SetColoreCella(12,1,vbWhite)
   If avalori(13) > 0100 Then Call SetColoreCella(13,1,vbWhite)
   If avalori(14) > 0100 Then Call SetColoreCella(14,1,vbWhite)
   If avalori(15) > 0100 Then Call SetColoreCella(15,1,vbWhite)
   If avalori(16) > 0100 Then Call SetColoreCella(16,1,vbWhite)
   If avalori(17) > 0150 Then Call SetColoreCella(17,7,0)
  Next
  Call CreaTabella(0,,,righe) '(4,,,righe)colonne x ritardo
 Next
 nend = Timer
 Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 1) - nstart))
End Sub
Function RitDiPos(nu,pos,aruote)
 ReDim apos(5)
 apos(pos) = True
 RitDiPos = RitardoCombinazioneTurbo(aruote,nu,1,0,apos)
End Function
Function FormattaSecondi(s)
 'Questa Function trasforma il numero di secondi passato come parametro in una stringa
 ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
 ' s ---> Numero di secondi da formattare
 ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
 Dim hh
 Dim Mm
 Dim Ss
 Dim TimeStr
 hh = s \ 3600
 Mm =(s Mod 3600) \ 60
 Ss = s -((hh * 3600) +(Mm * 60))
 TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
 FormattaSecondi = TimeStr
End Function

Codice:

Sub Main
 Dim a(8)'NUMERO DA MODIFICARE IN BASE ALLE COMBINAZIONI INSERITE__TABELLA__
 Dim Ru(1)
 Dim k
 Dim nu
 ReDim aruote(12)
 righe = InputBox("Quante righe vuoi vedere ",,5)
 Scrivi "Quartine Radicali  Ruota di... ",1,0,3
 If ScegliRuote(aruote) > 0 Then
  For k = 1 To UBound(aruote)
   If aruote(k) > 0 Then
    Scrivi " " & NomeRuota(aruote(k)),1,0,4
   End If
  Next
 End If
 Dim posta(2)
 posta(1) = 1
 posta(2) = 1
 nstart = Timer
 Fin = EstrazioneFin
 Ini = EstrazioneIni
 Scrivi NomeRuota(Ru(1)),1,0
 Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)
 ReDim atitoli(16)
 atitoli(1) = "8"
 atitoli(2) = " COMBINAZIONI "
 atitoli(3) = "RA1 "
 atitoli(4) = "RA2 "
 atitoli(5) = "RA3 "
 atitoli(6) = "RS1 "
 atitoli(7) = "RS2 "
 atitoli(8) = "RS3 "
 'atitoli(9) = "FR1 "
 'atitoli(10) = "FR2 "
 'atitoli(11) = "FR3 "
 atitoli(9) = "RD1 "
 atitoli(10) = "RD2 "
 atitoli(11) = "RD3 "
 atitoli(12) = "RD4 "
 atitoli(13) = "RD5 "
 atitoli(14) = "2Rp1"
 atitoli(15) = "2Rp2"
 atitoli(16) = "2Rp3"
 Call InitTabella(atitoli,0,,2,5)
 a(1) = "1-10-11-19"
 a(2) = "2-20-22-29"
 a(3) = "3-30-33-39"
 a(4) = "4-40-44-49"
 a(5) = "5-50-55-59"
 a(6) = "6-60-66-69"
 a(7) = "7-70-77-79"
 a(8) = "8-80-88-89"
 For N = 1 To UBound(a)
  nu = Split("0-" &(a(n)),"-")
  sr1 = SerieRitardoTurbo(Ini,fin,nu,aruote,1)', 1 scrive il ritardo dell'estratto
  sr2 = SerieRitardoTurbo(Ini,fin,nu,aruote,2)
  sr3 = SerieRitardoTurbo(Ini,fin,nu,aruote,3)
  sr4 = SerieRitardoTurbo(Ini,fin,nu,aruote,4)
  sr5 = SerieRitardoTurbo(Ini,fin,nu,aruote,5)
  st1 = SerieStoricoTurbo(Ini,fin,nu,aruote,1)
  st2 = SerieStoricoTurbo(Ini,fin,nu,aruote,2)
  st3 = SerieStoricoTurbo(Ini,fin,nu,aruote,3)
  st4 = SerieStoricoTurbo(Ini,fin,nu,aruote,4)
  st5 = SerieStoricoTurbo(Ini,fin,nu,aruote,5)
  sf1 = SerieFreqTurbo(Ini,Fin,nu,aruote,1)
  sf2 = SerieFreqTurbo(Ini,Fin,nu,aruote,2)
  sf3 = SerieFreqTurbo(Ini,Fin,nu,aruote,3)
  sf4 = SerieFreqTurbo(Ini,Fin,nu,aruote,4)
  sf5 = SerieFreqTurbo(Ini,fin,nu,aruote,5)
  Call VerificaEsitoTurbo(nu,aruote,fin,2,1,,retesito,,retestratti)
  ReDim avalori(16)
  avalori(1) = n
  avalori(2) = StringaNumeri(nu)
  avalori(3) = sr1
  avalori(4) = sr2
  avalori(5) = sr3
  avalori(6) = st1
  avalori(7) = st2
  avalori(8) = st3
  'avalori(9) = sf1
  'avalori(10) = sf2
  'avalori(11) = sf3
  avalori(9) = RitDiPos(nu,1,aruote)
  avalori(10) = RitDiPos(nu,2,aruote)
  avalori(11) = RitDiPos(nu,3,aruote)
  avalori(12) = RitDiPos(nu,4,aruote)
  avalori(13) = RitDiPos(nu,5,aruote)
  ReDim rp(4) 'Numero da modificare in base hai Ritardi Prec. inseriti.
  Inizio = EstrazioneIni
  fine = EstrazioneFin
  'somrit = 0
  For z = 1 To 4 'Numero da modificare in base hai Ritardi Prec. inseriti.
   rp(z) = SerieRitardoTurbo(Inizio,fine,nu,aruote,2) '1 Rit.Prec ESTRATTO_2 AMBO_3 TERNO ....
   fine = fine -(rp(z) + 1)
   'somrit = somrit + rp(z)
   'Medrit = Int(somrit/z)
  Next
  ' il primo rp(1) = ritardo corrente
  avalori(14) = rp(2) ' scrive 1 ritardo precedente
  avalori(15) = rp(3)
  avalori(16) = rp(4)
  Call AddRigaTabella(avalori)
  Call SetColoreCella(1,,vbBlue)
  Call SetColoreCella(2,,vbRed)' colora la colonna 2 sfondo ciano scritta gialla
  Call SetColoreCella(3,4,0)
  Call SetColoreCella(4,4,0)
  Call SetColoreCella(5,4,0)
  Call SetColoreCella(9,RGB(224,31,20),vbWhite)
  Call SetColoreCella(10,RGB(224,31,20),vbWhite)
  Call SetColoreCella(11,RGB(224,31,20),vbWhite)
  Call SetColoreCella(12,RGB(224,31,20),vbWhite)
  Call SetColoreCella(13,RGB(224,31,20),vbWhite)
  If avalori(3) > 20 Then Call SetColoreCella(3,2,vbWhite) 'RA
  If avalori(4) > 100 Then Call SetColoreCella(4,3,0) 'RA
  If avalori(4) > 500 Then Call SetColoreCella(4,2,0) 'RA
  'If avalori(4) > 500 Then Call SetColoreCella(4,2,vbWhite) 'RA
  'If avalori(6) > 30 Then Call SetColoreCella(6,2,0) 'RS
  If avalori(7) > 800 Then Call SetColoreCella(7,2,0) 'RS
  If avalori(09) > 100 Then Call SetColoreCella(9,1,vbWhite)
  If avalori(10) > 100 Then Call SetColoreCella(10,1,vbWhite)
  If avalori(11) > 100 Then Call SetColoreCella(11,1,vbWhite)
  If avalori(12) > 100 Then Call SetColoreCella(12,1,vbWhite)
  If avalori(13) > 100 Then Call SetColoreCella(13,1,vbWhite)
  If avalori(09) > 200 Then Call SetColoreCella(9,3,2)
  If avalori(10) > 200 Then Call SetColoreCella(10,3,2)
  If avalori(11) > 200 Then Call SetColoreCella(11,3,2)
  If avalori(12) > 200 Then Call SetColoreCella(12,3,2)
  If avalori(13) > 200 Then Call SetColoreCella(13,3,2)
  If avalori(09) > 300 Then Call SetColoreCella(9,4,2)
  If avalori(10) > 300 Then Call SetColoreCella(10,4,2)
  If avalori(11) > 300 Then Call SetColoreCella(11,4,2)
  If avalori(12) > 300 Then Call SetColoreCella(12,4,2)
  If avalori(13) > 300 Then Call SetColoreCella(13,4,2)
  If avalori(14) > 400 Then Call SetColoreCella(14,7,0)
 Next
 Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1
 Call CreaTabella(4,,,righe) '(4,,,righe)colonne x ritardo
 'Call CreaTabella(4,,,righe)
 nend = Timer
 Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 1) - nstart))
End Sub
Function RitDiPos(nu,pos,aruote)
 ReDim apos(5)
 apos(pos) = True
 RitDiPos = RitardoCombinazioneTurbo(aruote,nu,1,0,apos)
End Function
Function FormattaSecondi(s)
 'Questa Function trasforma il numero di secondi passato come parametro in una stringa
 ' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
 ' s ---> Numero di secondi da formattare
 ' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
 Dim hh
 Dim Mm
 Dim Ss
 Dim TimeStr
 hh = s \ 3600
 Mm =(s Mod 3600) \ 60
 Ss = s -((hh * 3600) +(Mm * 60))
 TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
 FormattaSecondi = TimeStr
End Function

Giulio LG · 14 Febbraio 2013

PosizioniFrequenza ( Autore Blackmore )

Codice:

Sub Main()
 'hh = InputBox("ESTRAZIONE INIZIALE",,8201) 
 wh = ScegliRuota
 xx = CInt(InputBox("NUMERO DA CERCARE",,53))
 Ini = EstrazioneFin - 360 '''''
 Fin = EstrazioneFin '''''
 'ini = hh
 'fin = EstrazioneFin
 ColoreTesto 1:Scrivi "Periodo di ricerca___dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin) & "___Totale estrazioni esaminate___" & fin - Ini,1:Scrivi:ColoreTesto 0
 Scrivi String(85,"-"),1
 For es = ini To fin
  p = 1
  a = Estratto(es,wh,p)
  If a = xx Then
   casi = casi + 1
   Scrivi DataEstrazione(es) & "  " & FormatSpace(NomeRuota(wh),5) & "  " & StringaEstratti(es,wh) & "  Numero Trovato  " & Format2(xx) & " in " & p & "° Posizione ... Caso n° " & Format2(casi)
  End If
 Next
 ColoreTesto 2:Scrivi:Scrivi "Totale casi Trovati con il " & xx & " in " & p & "° Posizione = " & CInt(casi),1
 ColoreTesto 0
 Scrivi String(85,"-"),1
 casi = 0
 For es = ini To fin
  p = 2
  a = Estratto(es,wh,p)
  If a = xx Then
   casi = casi + 1
   Scrivi DataEstrazione(es) & "  " & FormatSpace(NomeRuota(wh),5) & "  " & StringaEstratti(es,wh) & "  Numero Trovato  " & Format2(xx) & " in " & p & "° Posizione ... Caso n° " & Format2(casi)
  End If
 Next
 ColoreTesto 2:Scrivi:Scrivi "Totale casi Trovati con il " & xx & " in " & p & "° Posizione = " & CInt(casi),1
 ColoreTesto 0
 Scrivi String(85,"-"),1
 casi = 0
 For es = ini To fin
  p = 3
  a = Estratto(es,wh,p)
  If a = xx Then
   casi = casi + 1
   Scrivi DataEstrazione(es) & "  " & FormatSpace(NomeRuota(wh),5) & "  " & StringaEstratti(es,wh) & "  Numero Trovato  " & Format2(xx) & " in " & p & "° Posizione ... Caso n° " & Format2(casi)
  End If
 Next
 ColoreTesto 2:Scrivi:Scrivi "Totale casi Trovati con il " & xx & " in " & p & "° Posizione = " & CInt(casi),1
 ColoreTesto 0
 Scrivi String(85,"-"),1
 casi = 0
 For es = ini To fin
  p = 4
  a = Estratto(es,wh,p)
  If a = xx Then
   casi = casi + 1
   Scrivi DataEstrazione(es) & "  " & FormatSpace(NomeRuota(wh),5) & "  " & StringaEstratti(es,wh) & "  Numero Trovato  " & Format2(xx) & " in " & p & "° Posizione ... Caso n° " & Format2(casi)
  End If
 Next
 ColoreTesto 2:Scrivi:Scrivi "Totale casi Trovati con il " & xx & " in " & p & "° Posizione = " & CInt(casi),1
 ColoreTesto 0
 Scrivi String(85,"-"),1
 casi = 0
 For es = ini To fin
  p = 5
  a = Estratto(es,wh,p)
  If a = xx Then
   casi = casi + 1
   Scrivi DataEstrazione(es) & "  " & FormatSpace(NomeRuota(wh),5) & "  " & StringaEstratti(es,wh) & "  Numero Trovato  " & Format2(xx) & " in " & p & "° Posizione ... Caso n° " & Format2(casi)
  End If
 Next
 ColoreTesto 2:Scrivi:Scrivi "Totale casi Trovati con il " & xx & " in " & p & "° Posizione = " & CInt(casi),1
 ColoreTesto 0
 Scrivi String(85,"-"),1
End Sub

RitardoGlobale ( Autore Rubino )

Codice:

Sub Main
 ''''' combinazioni a scelta naMe script   MIKIaSceltaSingle-Ambata-Ambo
 ''''   esplode x single / coppie e/o terzine combinazione richiesta
 Dim numeri(90)
 Dim art(1)
 Dim r
 Dim combinazione
 Dim lancia
 Dim des
 Dim nsorte,fine,Ini
 Ini = 3950
 fine = EstrazioneFin
 Ord = InputBox("Ordinamento discendente per                       (Rit.Att. = 3) (Ritardo Max = 4)  (Frequenza = 5 )  (Rit.Glob. = 6)",,6)
 r = InputBox("Scegli Ruota  ",,1)
 art(1) = r
 svi = InputBox("Sviluppo in  Single - Coppie o Terzine (S - C - T) ",,"S")
 te = ""
 If svi = "S" Or svi = "s" Then te = "Single"
 If svi = "C" Or svi = "c" Then te = "Coppie"
 If svi = "T" Or svi = "t" Then te = "Terzine"
 des = ""
 nsorte = InputBox("Sorte 1=Ambata   2=Ambo   ",,1)
 If nsorte = 1 Then des = " 1 = Ambata "
 If nsorte = 2 Then des = " 2 = Ambo   "
 'scelgo numeri combinazione di ricerca
 Call ScegliNumeri(numeri)
 qtn = UBound(numeri)
 combinazione = ""
 c = 0
 For c = c + 1 To qtn
  combinazione = combinazione & Format2(numeri(c)) & " "
 Next
 Scrivi " Statistica effettuata all'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
 Scrivi " Sviluppa combinazione Integrale                             namescript  MIKIaSceltaSingle-Ambata-Ambo  "
 Scrivi " Combinazione di numeri inseriti..." & combinazione,1,- 1,- 1
 Scrivi " Hai scelto lo sviluppo in " & te & "  per la sorte " & des,1,- 1
 Scrivi "______________________________________________________________________"
 Scrivi
 'scompongo combinazione numeri
 ReDim aV(0)
 Call SplitByChar(numeri(1),"-",aV)
 ReDim atitoli(27)
 ' preimposto i titoli delle colonne
 atitoli(1) = "Ruota           "
 atitoli(2) = "Numeri          "
 atitoli(3) = "Rit.att"
 atitoli(4) = " Rit.Max"
 atitoli(5) = " Freque "
 atitoli(6) = " Rit.Glob."
 atitoli(7) = " Rit.01 "
 atitoli(8) = " Rit.02 "
 atitoli(9) = " Rit.03 "
 atitoli(10) = " Rit.04 "
 atitoli(11) = " Rit.05 "
 atitoli(12) = " Rit.06 "
 atitoli(13) = " Rit.07 "
 atitoli(14) = " Rit.08 "
 atitoli(15) = " Rit.09 "
 atitoli(16) = " Rit.10 "
 atitoli(17) = " RP11 "
 atitoli(18) = "RP12"
 atitoli(19) = "RP13"
 atitoli(20) = "RP14"
 atitoli(21) = "RP15"
 atitoli(22) = "RP16"
 atitoli(23) = "RP17"
 atitoli(24) = "RP18"
 atitoli(25) = "RP19"
 atitoli(26) = "RP20"
 atitoli(27) = " R.G/R.A"
 ' inizializzo la tabella
 Call InitTabella(atitoli,1,,,5)
 ''''---------------------------------------------------------------------------------------------------------
 '''' sviluppo in Single
 If svi = "S" Or svi = "s" Then
  da = 0
  For da = da + 1 To qtn
   ReDim nx(1)
   nx(1) = Format2(numeri(da))
   lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte)
  Next
  '''' e riepilogo combinazione intera
  da = 0
  ReDim nx(90)
  For da = da + 1 To qtn
   nx(da) = Format2(numeri(da))
  Next
  lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte)
 End If
 '''''---------------------------------------------------------------------------------------------------------
 ''''---------------------------------------------------------------------------------------------------------
 '''' sviluppo in ambi
 If svi = "C" Or svi = "c" Then
  da = 0
  a = 0
  For da = da + 1 To qtn - 1
   a = da
   For a = a + 1 To qtn
    ReDim nx(2)
    nx(1) = Format2(numeri(da))
    nx(2) = Format2(numeri(a))
    lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte)
   Next
  Next
 End If
 '''''---------------------------------------------------------------------------------------------------------
 '''' sviluppo in terzine
 If svi = "T" Or svi = "t" Then
  da = 0
  a = 0
  af = 0
  For da = da + 1 To qtn - 2
   a = da
   For a = a + 1 To qtn - 1
    af = a
    For af = af + 1 To qtn
     ReDim nx(3)
     nx(1) = Format2(numeri(da))
     nx(2) = Format2(numeri(a))
     nx(3) = Format2(numeri(af))
     lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte)
    Next
   Next
  Next
 End If
 Call CreaTabella(Int(ord))
End Sub
''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte)
 Dim Ritardo,RitardoMax,IncrRitMax,Frequenza,sRetGruppiAnalizz,aRetRitardi,aRetIdEstr,sorte
 '''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
 '''' somma ritardi in ritardo globale e ricerca il ritardo attuale
 '''' mette in tabella ed ordina per ritardo globale discendente
 somrit = 0
 ReDim an(90)
 For q = 1 To UBound(nx)
  an(q) = Format2(nx(q))
 Next
 ' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
 ReDim aValori(27) '
 aValori(1) = NomeRuota(r)
 If UBound(nx) = 1 Then aValori(2) = an(1)
 If UBound(nx) > 1 And UBound(nx) < 4 Then aValori(2) = an(1) & " " & an(2) & " " & an(3)
 If UBound(nx) > 3 Then aValori(2) = an(1) & " " & an(2) & " " & an(3) & " " & an(4) & " " & an(5) & " " & an(6) & " " & an(7) & " " & an(8) & " " & an(9) & " " & an(10) & " " & an(11) & " " & an(12) & " " & an(13)
 sorte = nsorte
 Call StatisticaFormazione(an,art,sorte,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
 aValori(3) = Ritardo
 aValori(4) = RitardoMax
 aValori(5) = Frequenza
 Call ElencoRitardiTurbo(an,art,nsorte,EstrazioneIni,fine,aRetRitardi,aRetIdEstr)
 last20 = UBound(aRetRitardi) - 20
 last = UBound(aRetRitardi)
 f1 = 0
 f = 6
 For f1 = f1 + 1 To 20
  aValori(f + f1) = aRetRitardi(last - f1)
  somrit = somrit + aRetRitardi(last - f1)
 Next
 aValori(6) = somrit
 If aValori(3) > 0 Then rapp = aValori(6) / aValori(3) Else rapp = 0 End If
 aValori(27) = Round(rapp,1)
 Call AddRigaTabella(aValori,Bianco_,"center",1)
 Call SetColoreCella(6,vbYellow,vbBlue)
 Call SetColoreCella(3,vbYellow,vbBlue)
 If Ritardo >= RitardoMax Then
  Call SetColoreCella(3,vbRed,vbWhite)
  Call SetColoreCella(4,vbRed,vbWhite)
 End If
 If aValori(25) > 5 And aValori(25) < 7 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 10 And aValori(25) < 12 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 12 And aValori(25) < 14 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 14 And aValori(25) < 16 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 5 And aValori(25) < 7 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 10 And aValori(25) < 12 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 12 And aValori(25) < 14 Then Call SetColoreCella(25,vbRed,vbWhite)
 If aValori(25) > 14 And aValori(25) < 16 Then Call SetColoreCella(25,vbRed,vbWhite)
 GetRitardi = Lancia
End Function
''''------------------------------------------------------------------------------------------------------------------

NumeriFrequenza ( Autore Joe91 )

Codice:

'Gaussiana delle Frequenze By Joe
Sub Main()
 Dim Nu(1),Ru(1),SF(90)
 Ini = EstrazioneFin - 360
 Fin = EstrazioneFin
 For R = 1 To 12 : If R = 11 Then: R = 12
 End If
 Scrivi NomeRuota(R) & " " & DataEstrazione(Ini) & " - " & DataEstrazione(Fin),1
 Mx = 0 : Ru(1) = R
 For N = 1 To 90 : Nu(1) = N
  SF(N) = SerieFreq(Ini,Fin,Nu,Ru,1)
  If Mx <= SF(N) Then Mx = SF(N)
 Next
 For Q = 0 To MX
  Scrivi"F=" & "F=" & Format2(Q) & " -> ",0,0
  For N = 1 To 90
   If SF(N) = Q Then Scrivi Format2(N) & " ",0,0
  Next : Scrivi : Next : Scrivi String(90,"="),1
 Next
End Sub

Ambo TT ( Autori Costantini & Joe91 )

Codice:

Sub Main
 Dim RitMinimo
 Dim NumeriCercati
 Dim RitardoMinimo
 Dim i,j,k,n,r,q,w,jj,qqq
 Dim FineRuote
 Dim Fine
 Dim FineCiclo
 Dim AmbiRitardoValido
 Dim RitardoAttuale
 Dim Ritardo
 'Script realizzato da Denis COSTANTINI - 23/06/2007
 'lo script esegue la ricerca delle formazioni da 2 fino a 7 numeri
 'in maggior ritardo su TUTTE per la sorte di ambo
 'tempo stimato (usando i valori indicati in RitMinimo) circa 30 secondi
 Scrivi("TABELLONE DELLE PRINCIPALI COMBINAZIONI IN RITARDO PER AMBO SU TUTTE")
 Call Scrivi("aggiornato all'estrazione n° " & EstrazioniArchivio & " del " & DataEstrazione(EstrazioniArchivio))
 Call Scrivi("")
 'valori di ritardo minimo per velocizzare (!) la ricerca
 RitMinimo = Array(0,0,270,135,90,68,55,45)
 'inizia ricerca combinazioni da 2 a 7 numeri in ritardo per ambo su TUTTE
 For NumeriCercati = 2 To 7
  ReDim MaxRuota(11) ' MaxRuota = VarArrayCreate([0,11],3)
  ReDim MaxNumero(90) ' MAxNumero = VarArrayCreate([0,90],3)
  ReDim RuotaCercata(11)' RuotaCercata = VarArrayCreate([0,11],3)
  ReDim Minim(90,90)' = VarArrayCreate([0,90,0,90],3)
  ReDim RitAmbo(90,90) ' RitAmbo = VarArrayCreate([0,90,0,90],3)
  ReDim Numeri(90) ' Numeri = VarArrayCreate([0,90],3)
  ReDim OrdCom(20) ' OrdCom = VarArrayCreate([0,20],12)
  ReDim OrdRit(20) ' OrdRit = VarArrayCreate([0,20],3)
  Scrivi("combinazioni di " & NumeriCercati & " numeri con ritardo minimo di " & RitMinimo(NumeriCercati) & " estrazioni")
  Scrivi("")
  RitardoMinimo = RitMinimo(NumeriCercati)
  'ricerca dei numeri richiesti
  For i = 1 To 10
   MaxRuota(i) = i
  Next
  FineRuote = 1 'indica al programma di continuare la ricerca finchè FineRuote=0
  r = 0
  RuotaCercata(r) = 0
  Do
   r = r + 1
   RuotaCercata(r) = RuotaCercata(r - 1) + 1
   If RuotaCercata(r) > MaxRuota(r) Then
    Do
     r = r - 1
     If r = 0 Then
      FineRuote = 0
      Exit Do
     End If
     RuotaCercata(r) = RuotaCercata(r) + 1
    Loop Until RuotaCercata(r) <= MaxRuota(r)
   End If
   If r = 10 Then
    'memorizza il ritardo minimo dei 4005 ambi sulle ruote individuate
    For i = 1 To 89
     For j =(i + 1) To 90
      Minim(i,j) = EstrazioniArchivio
      For k = 1 To 10
       If AmboRitardoTurbo(RuotaCercata(k),i,j) < Minim(i,j) Then
        Minim(i,j) = AmboRitardoTurbo(RuotaCercata(k),i,j)
       End If
      Next
     Next
    Next
    For i = 1 To NumeriCercati
     MaxNumero(i) = 90 + i - NumeriCercati
    Next
    n = 1
    Numeri(n) = 1
    'inizia la ricerca dei numeri
    Do
     Fine = 1
     n = n + 1
     Numeri(n) = Numeri(n - 1) + 1
     Do
      If Numeri(n) > MaxNumero(n) Then
       Do
        n = n - 1
        If n = 0 Then
         Fine = 0
         Exit Do
        End If
        Numeri(n) = Numeri(n) + 1
       Loop Until Numeri(n) <= MaxNumero(n)
      End If
      If n > 1 Then
       FineCiclo = 1
       'controllo ritardo degli ambi
       AmbiRitardoValido = 0 : Ritardo = EstrazioniArchivio
       For j = 1 To(n - 1)
        RitardoAttuale = Minim(Numeri(j),Numeri(n))
        If RitardoAttuale < RitardoMinimo Then
         Exit For
        Else
         AmbiRitardoValido = AmbiRitardoValido + 1
        End If
       Next
       If AmbiRitardoValido =(n - 1) Then
        If n = NumeriCercati Then
         'trovato una combinazione
         qqq = " "
         For q = 1 To n
          If Numeri(q) > 9 Then
           qqq = qqq & Numeri(q) & " "
          Else
           qqq = qqq & " " & Numeri(q) & " "
          End If
         Next
         For q = 1 To(n - 1)
          For w =(q + 1) To n
           If Ritardo > Minim(Numeri(q),Numeri(w)) Then
            Ritardo = Minim(Numeri(q),Numeri(w))
           End If
          Next
         Next
         '
         jj = 0
         For j = 10 To 1 Step - 1
          If Ritardo > OrdRit(j) Then
           jj = j
          End If
         Next
         If jj > 0 Then
          If jj = 20 Then
           OrdRit(20) = Ritardo
           OrdCom(20) = qqq
          Else
           For j = 20 To jj + 1 Step - 1
            OrdRit(j) = OrdRit(j - 1)
            OrdCom(j) = OrdCom(j - 1)
           Next
           OrdRit(jj) = Ritardo
           OrdCom(jj) = qqq
          End If
         End If
         '
         '                Scrivi("")
         Numeri(n) = Numeri(n) + 1
        Else
         FineCiclo = 0
        End If
       Else
        Numeri(n) = Numeri(n) + 1
        FineCiclo = 1
       End If
      Else
       FineCiclo = 0
      End If
      If Fine = 0 Then Exit Do End If
     Loop Until FineCiclo = 0
    Loop Until Fine = 0
   End If
  Loop Until FineRuote = 0
  '
  For j = 1 To 20
   If OrdRit(j) > 0 Then
    Call Scrivi("TUTTE   " & OrdCom(j) & "    ritardo : " & OrdRit(j))
   End If
  Next
  '
  Scrivi("-----------------------------------------------------------------------")
  'PosizioneBarra(2,7,NumeriCercati)
  Call AvanzamentoElab(2,7,NumeriCercati)
  If ScriptInterrotto Then Exit For
 Next
End Sub

FREQ. POS. ( Autore Rubino )

Codice:

[COLOR=#0000FF]Sub Main()
 Dim nm(90),ed(5),ar(1)
 Dim wn,Ini,fin,y,r,es,L,v,vn,z,b,numeri,RetRit,RetRitMax,Inizio
 r = ScegliRuota
 wn = ScegliNumeri(nm)
 Ini = EstrazioneFin - 360 '''''
 Inizio = EstrazioneIni
 fin = EstrazioneFin '''''
 ar(1) = r
 ColoreTesto(1)
 Scrivi " Periodo di ricerca___dal " & DataEstrazione(Ini) & " al " & DataEstrazione(fin) & "___Totale estrazioni esaminate___" & fin - Ini
 ColoreTesto(2)
 Scrivi " Ruota " & NomeRuota(r),1
 Scrivi " Combinazione Numerica selezionata " & StringaNumeri(nm),1
 Scrivi "----------------------------------------------------------------------------",1
 ColoreTesto(0)
 For b = 1 To wn
  numeri = numeri & nm(b) & "-"
 Next
 ReDim aV(90)
 Call SplitByChar(numeri,"-",aV)
 For es = Ini To fin
  For y = 1 To 5
   For z = 1 To wn
    If Estratto(es,r,y) = Int(aV(z - 1)) Then
     ed(y) = ed(y) + 1
    End If
   Next
  Next
 Next
 Call StatisticaFormazioneTurbo(nm,ar,1,RetRit,RetRitMax,,,Inizio,fin)
 Scrivi " Ritardo attuale " & RetRit
 Scrivi " Ritardo Max     " & RetRitMax
 Scrivi "-------------------------",1
 For v = 1 To 5
  Scrivi " Posizione..." & v & " tot.Uscite...." & ed(v),1
 Next
End Sub
[/COLOR]

Giulio LG · 10 Aprile 2013

Lotto ArchivioReale > BUCHI < ( Autore Joe91_Re Giorgio )

Lotto ArchivioReale > BUCHI < ( Autore Joe91_Re Giorgio )

Codice:

[COLOR=#FF0000]Sub Main
R= BA_ 
 For Es = 1 To EstrazioniArchivio
 If SommaEstratti (Es,R)>0 Then 
 K=K+1
 Else
 'Scrivi Es 
 End If
 Next
 Scrivi EstrazioniArchivio - K
End Sub[/COLOR]

[TABLE="class: cms_table"]
[TR]
[TD="align: center"]Ini[/TD]
[TD="align: center"]Fin[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]Nz[/TD]
[/TR]
[TR]
[TD="align: right"]1[/TD]
[TD="align: right"]173[/TD]
[TD="align: right"]173[/TD]
[TD="align: right"]173[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]173[/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro [/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]173[/TD]
[/TR]
[TR]
[TD="align: right"]174[/TD]
[TD="align: right"]3574[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]3401[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]3401[/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]3401[/TD]
[/TR]
[TR]
[TD="align: right"]3575[/TD]
[TD="align: right"]3765[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]191[/TD]
[/TR]
[TR]
[TD="align: right"]3766[/TD]
[TD="align: right"]3771[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]3772[/TD]
[TD="align: right"]3773[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]2[/TD]
[/TR]
[TR]
[TD="align: right"]3774[/TD]
[TD="align: right"]3776[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]3777[/TD]
[TD="align: right"]3779[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]3780[/TD]
[TD="align: right"]3785[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]3786[/TD]
[TD="align: right"]3792[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD="align: right"]3793[/TD]
[TD="align: right"]3793[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]3794[/TD]
[TD="align: right"]3794[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]3795[/TD]
[TD="align: right"]3798[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]3799[/TD]
[TD="align: right"]3802[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]4[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]4[/TD]
[/TR]
[TR]
[TD="align: right"]3803[/TD]
[TD="align: right"]3818[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]16[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD="align: right"]3819[/TD]
[TD="align: right"]3819[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]3820[/TD]
[TD="align: right"]3839[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]20[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]20[/TD]
[/TR]
[TR]
[TD="align: right"]3840[/TD]
[TD="align: right"]3846[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]7[/TD]
[/TR]
[TR]
[TD="align: right"]3847[/TD]
[TD="align: right"]3849[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]3[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]3[/TD]
[/TR]
[TR]
[TD="align: right"]3850[/TD]
[TD="align: right"]3855[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]3856[/TD]
[TD="align: right"]3861[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]6[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]6[/TD]
[/TR]
[TR]
[TD="align: right"]3862[/TD]
[TD="align: right"]3877[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]16[/TD]
[/TR]
[TR]
[TD="align: right"]3878[/TD]
[TD="align: right"]3878[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]3879[/TD]
[TD="align: right"]3948[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]70[/TD]
[/TR]
[TR]
[TD="align: right"]3949[/TD]
[TD="align: right"]3949[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]1[/TD]
[/TR]
[TR]
[TD="align: right"]3950[/TD]
[TD="align: right"]7439[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]3490[/TD]
[/TR]
[TR]
[TD="align: right"]7440[/TD]
[TD="align: right"]7814[/TD]
[TD="align: right"]Ba[/TD]
[TD="align: right"]Ca[/TD]
[TD="align: right"]Fi[/TD]
[TD="align: right"]Ge [/TD]
[TD="align: right"]Mi[/TD]
[TD="align: right"]Na[/TD]
[TD="align: right"]Pa[/TD]
[TD="align: right"]Ro[/TD]
[TD="align: right"]To [/TD]
[TD="align: right"]Ve[/TD]
[TD="align: right"]Nz[/TD]
[/TR]
[TR]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[TD="align: right"][/TD]
[/TR]
[TR]
[TD="align: left"]Buchi[/TD]
[TD="align: left"]Arch.[/TD]
[TD="align: right"]173[/TD]
[TD="align: right"]3648[/TD]
[TD="align: right"]7[/TD]
[TD="align: right"]3576[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]5[/TD]
[TD="align: right"]25[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]1[/TD]
[TD="align: right"]2[/TD]
[TD="align: right"]7439[/TD]
[/TR]
[/TABLE]

Giulio LG · 16 Aprile 2013

CapoGioco ( Autore Rubino )

CapoGioco ( Autore Rubino )

Codice:

Sub Main
 ''''' combinazioni a scelta   script  MIKI55Capog  (Rubino)
 Dim art(1)
 Dim r,combinazione,lancia,des,nsorte,fine,Ini,ord,svi,c,qtn,da,a,af,cap,abbin,te,ct,nx,max,nc,defaul,diecicicli
 r = InputBox("Scegli Ruota  ",,5)
 cap = CInt(InputBox("Capogioco ",,70))
 nc = InputBox("Len ciclo Equilibrio Instabile su TT",,2)
 defaul = InputBox("Estr.Determinati  S=Scarto  R=Usc.Reali",,"S")
 diecicicli = InputBox("Estr.Determinati Rilevamento 10c=10cicli o  ST=Storico",,"10")
 fine = EstrazioneFin
 te = ""
 art(1) = r
 svi = "S"
 If svi = "S" Or svi = "s" Then te = "Single-Coppia Abbinata "
 Ini = EstrazioneIni ' inizio tutte le altre ruote
 If r = 12 Then Ini = 7440 'inizio nazionale
 If r = 1 Then Ini = 174 'inizio bari
 If r = 2 Then Ini = 3649 'inizio cagliari
 If r = 4 Then Ini = 3577 'inizio genova
 des = ""
 nsorte = 1
 If nsorte = 1 Then des = " 1 = Ambata "
 Scrivi " Statistica dall'estrazione " & Ini & " / " & DataEstrazione(Ini) & " - All'estrazione n. " & EstrazioneFin & " / " & DataEstrazione(EstrazioneFin),1,- 1,- 1
 If diecicicli <> "ST" And diecicicli <> "st" Then Scrivi " Rilevo Estratti Determinati su Lunghezza Ciclo..uguale a 10 Cicli ",1
 If diecicicli = "ST" Or diecicicli = "st" Then Scrivi " Rilevo Estratti Determinati su Lunghezza Ciclo (Storico) " & "Range dall'estrazione n. " & Ini & "   alla n. " & fine,1
 Scrivi " Rilevo Estratti Determinati su Tutte le ruote su Lunghezza Ciclo (" & nc & " * 18)      " & "Range dall'estrazione n. " &(fine + 1) -(18*nc) & "   alla n. " & fine,1
 If defaul = "R" Then
  Scrivi " Rileva Estratti Determinati Reali su Ruota Fissa nel range di date scelte ",1
 Else
  Scrivi " Rileva Estratti Determinati (Scarto) su Ruota Fissa nel range di date scelte ",1
 End If
 Scrivi "____script = Miki55CapogSingle-Ambo____________________________________________R u b i n o____________________________________________________________",1,- 1,3
 Scrivi " C a p o g i o c o   R i c h i e s t o ...." & cap,1,- 1,3
 ReDim atitoli(33)
 ' preimposto i titoli delle colonne
 atitoli(1) = "Ruota           "
 atitoli(2) = "Numeri          "
 atitoli(3) = "Rit.att"
 atitoli(4) = " Rit.Max"
 atitoli(5) = " Freque "
 atitoli(6) = " Rt.Glob"
 atitoli(7) = " Rit.01 "
 atitoli(8) = " Rit.02 "
 atitoli(9) = " Rit.03 "
 atitoli(10) = " Rit.04 "
 atitoli(11) = " Rit.05 "
 atitoli(12) = " Rit.06 "
 atitoli(13) = " Rit.07 "
 atitoli(14) = " Rit.08 "
 atitoli(15) = " Rit.09 "
 atitoli(16) = " Rit.10 "
 atitoli(17) = " Cons "
 atitoli(18) = " Rt.Ambo"
 atitoli(19) = " Rt.AmboTT"
 atitoli(20) = " Eds1 "
 atitoli(21) = " Eds2 "
 atitoli(22) = " Eds3 "
 atitoli(23) = " Eds4 "
 atitoli(24) = " Eds5 "
 atitoli(25) = " "
 atitoli(26) = " Eq.C10"
 atitoli(27) = " Eq.U>C"
 atitoli(28) = " "
 atitoli(29) = " Edtt1 "
 atitoli(30) = " Edtt2 "
 atitoli(31) = " Edtt3 "
 atitoli(32) = " Edtt4 "
 atitoli(33) = " Edtt5 "
 ' inizializzo la tabella
 Call InitTabella(atitoli,2,"center",1.3,5,"Arial")
 ''''---------------------------------------------------------------------------------------------------------
 '''' sviluppo in Single
 If svi = "S" Or svi = "s" Then
  'loop 90 numeri x abbinamento al capogioco
  For abbin = abbin + 1 To 90
   If ScriptInterrotto Then Exit For
   Call AvanzamentoElab(1,90,abbin)
   If cap <> abbin Then
    If ct = 0 Then
     nx = 1
     combinazione = Format2(cap)
     lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli)
     ct = 1
    End If
    combinazione = ""
    nx = 1
    combinazione = Format2(abbin)
    lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli)
    '''' e riepilogo combinazione intera
    combinazione = ""
    nx = 2
    combinazione = Format2(cap) & "-" & Format2(abbin)
    lancia = GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli)
   End If
  Next
 End If
 '''''---------------------------------------------------------------------------------------------------------
 Call CreaTabella(2)
 Scrivi
 Scrivi " Ritardo max dei max delle coppie è stato..." & max,1
 ColoreTesto(2)
 Scrivi " A p p u n t i :",1
 Scrivi " Esempio: ultimi 10 ritardi, nr.22 Rit.Att.79 Prec. 13 72  0 05 52 01 04 07 19 0 Max rit.72  Att.79"
 Scrivi " Esempio: ultimi 10 ritardi, nr.27 Rit.Att.13 Prec. 13 01 09 14 04 28 27 24 21 0 Max rit.31  Att.13"
 Scrivi " il capogioco n.22 ha superato il rit.max negli ult.10 ritardi precedenti e la coppia ha un ritardo att.13 vicino ai 18del cicloTeor."
 Scrivi " la coppia quindi deve avere ritardo minore e vicino a 18 x ambata"
End Sub
''''-----------------------------------------------------------------------------------------------------------
Function GetRitardi(nx,r,combinazione,art,Ini,fine,nsorte,max,nc,defaul,diecicicli)
 Dim Ritardo,RitardoMax,IncrRitMax,Frequenza,sRetGruppiAnalizz,aRetRitardi,aRetIdEstr,sorte,q,somrit,Totpesd,Inivai,y
 Dim cicloini,ultimic,uguali,ciclo,ncicli,rz,id,consec,fu,Inivaic,fx,fx1,consec2
 '''' RICERCA elenco ritardi e metti in evidenza gli ultimi 10
 '''' somma ritardi in ritardo globale e ricerca il ritardo attuale
 '''' mette in tabella ed ordina per ritardo globale discendente
 '  ' preimposto un array di comodo per creare la nuova riga da aggiungere alla tabella
 ReDim aValori(33) '
 ReDim ed(90,5),edtt(90,5)
 aValori(1) = NomeRuota(r)
 If nx = 1 Then
  ReDim an(1)
  an(1) = Left(combinazione,2)
  aValori(2) = an(1)
  ''''----------------------------------------------------------------------------------------------
  ''''routine per trovare presenze estratto determinato pos.1-2-3-4-5 nella storia
  If diecicicli = "ST" Or diecicli = "st" Then
   Totpesd =(fine - Ini)/90
   Inivai = Ini
  Else
   Totpesd = 10
   Inivai = fine - 899
  End If
  aValori(20) = ""
  aValori(21) = ""
  aValori(22) = ""
  aValori(23) = ""
  aValori(24) = ""
  For Inivai = Inivai + 1 To fine
   For y = 1 To 5
    If Int(Estratto(Inivai,r,y)) = Int(an(1)) Then
     ed(an(1),y) = ed(an(1),y) + 1
    End If
   Next
  Next
  If defaul = "S" Or defaul = "s" Then
   aValori(20) = ed(an(1),1) - Int(Totpesd)
   aValori(21) = ed(an(1),2) - Int(Totpesd)
   aValori(22) = ed(an(1),3) - Int(Totpesd)
   aValori(23) = ed(an(1),4) - Int(Totpesd)
   aValori(24) = ed(an(1),5) - Int(Totpesd)
  Else
   aValori(20) = ed(an(1),1)
   aValori(21) = ed(an(1),2)
   aValori(22) = ed(an(1),3)
   aValori(23) = ed(an(1),4)
   aValori(24) = ed(an(1),5)
  End If
  ''''routine per trovare presenze estratto determinato pos.1-2-3-4-5 nelle ult. 90 estrazione
  Inivaic =(fine + 1) -(18*nc)
  aValori(29) = ""
  aValori(30) = ""
  aValori(31) = ""
  aValori(32) = ""
  aValori(33) = ""
  For Inivaic = Inivaic + 1 To fine
   For rz = 1 To 10
    For y = 1 To 5
     If Int(Estratto(Inivaic,rz,y)) = Int(an(1)) Then
      edtt(an(1),y) = edtt(an(1),y) + 1
     End If
    Next
   Next
  Next
  aValori(29) = edtt(an(1),1)
  aValori(30) = edtt(an(1),2)
  aValori(31) = edtt(an(1),3)
  aValori(32) = edtt(an(1),4)
  aValori(33) = edtt(an(1),5)
  ''''----------------------------------------------------------------------------------------------
 End If
 If nx = 2 Then
  ReDim an(2)
  an(1) = Left(combinazione,2)
  an(2) = Right(combinazione,2)
  aValori(2) = an(1) & " " & an(2)
  ''''ricerca valori equilibrio instabile nella coppia (26 cicli totali - ultimi - ritardo att.coppia e max)
  cicloini =(fine + 1 - 180)
  ncicli = 10
  ReDim cic1(50)
  ReDim cic2(50)
  uguali = 0
  ultimic = 0
  For ciclo = 1 To ncicli
   cic1(ciclo) = EstrattoFrequenza(r,an(1),cicloini,cicloini + 17)
   cic2(ciclo) = EstrattoFrequenza(r,an(2),cicloini,cicloini + 17)
   cicloini = cicloini + 18
   If cic1(ciclo) = cic2(ciclo) Then
    uguali = uguali + 1
   End If
   If ciclo > 4 And cic1(ciclo) = cic2(ciclo) Then
    ultimic = ultimic + 1
   Else
    ultimic = 0
   End If
  Next
  aValori(26) = uguali
  aValori(27) = ultimic
 End If
 sorte = nsorte
 art(1) = r
 Call StatisticaFormazione(an,art,1,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
 aValori(3) = Ritardo
 aValori(4) = RitardoMax
 aValori(5) = Frequenza
 ReDim aRetRitardi(0)
 Call ElencoRitardiTurbo(an,art,1,Ini,fine,aRetRitardi,aRetIdEstr)
 last10 = UBound(aRetRitardi) - 10
 last = UBound(aRetRitardi)
 f1 = 0
 f = 6
 somrit = 0
 For f1 = f1 + 1 To 10
  aValori(f + f1) = aRetRitardi(last - f1)
  somrit = somrit + aRetRitardi(last - f1)
 Next
 aValori(6) = somrit
 If aValori(3) > 0 Then
  rapp = aValori(6) / aValori(3)
 Else
  rapp = 0
 End If
 ' aValori(17) = Round(rapp,1)
 If nx = 2 Then
  fx = 17
  consec = 0
  consec2 = 0
  For fx1 = 1 To 10
   If aValori(fx - fx1) > 8 Then
    consec = consec + 1
    consec2 = 0
   Else
    consec = 0
    consec2 = consec2 + 1
   End If
  Next
  If consec2 > 8 Then
   aValori(17) = consec2
  Else
   aValori(17) = consec
  End If
  art(1) = r
  Call StatisticaFormazione(an,art,2,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
  aValori(18) = Ritardo
  art(1) = 11
  Call StatisticaFormazione(an,art,2,Ritardo,RitardoMax,IncrRitMax,Frequenza,Ini,fine)
  aValori(19) = Ritardo
 Else
  aValori(18) = ""
  aValori(19) = ""
 End If
 aValori(25) = " "
 aValori(28) = " "
 Call AddRigaTabella(aValori,Bianco_,"center",1)
 Call SetColoreCella(17,RGB(214,214,214),vbBlack)
 Call SetColoreCella(6,RGB(214,214,214),vbBlack)
 Call SetColoreCella(20,RGB(217,255,255),vbBlack)
 Call SetColoreCella(21,RGB(217,255,255),vbBlack)
 Call SetColoreCella(22,RGB(217,255,255),vbBlack)
 Call SetColoreCella(23,RGB(217,255,255),vbBlack)
 Call SetColoreCella(24,RGB(217,255,255),vbBlack)
 Call SetColoreCella(29,RGB(217,255,255),vbBlack)
 Call SetColoreCella(30,RGB(217,255,255),vbBlack)
 Call SetColoreCella(31,RGB(217,255,255),vbBlack)
 Call SetColoreCella(32,RGB(217,255,255),vbBlack)
 Call SetColoreCella(33,RGB(217,255,255),vbBlack)
 Call SetColoreCella(25,RGB(0,4,164),vbBlack)
 Call SetColoreCella(28,RGB(0,4,164),vbBlack)
 If aValori(20) < - 10 Or aValori(20) > 10 Then
  Call SetColoreCella(20,RGB(1,147,158),vbWhite)
 End If
 If aValori(21) < - 10 Or aValori(21) > 10 Then
  Call SetColoreCella(21,RGB(1,147,158),vbWhite)
 End If
 If aValori(22) < - 10 Or aValori(22) > 10 Then
  Call SetColoreCella(22,RGB(1,147,158),vbWhite)
 End If
 If aValori(23) < - 10 Or aValori(23) > 10 Then
  Call SetColoreCella(23,RGB(1,147,158),vbWhite)
 End If
 If aValori(24) < - 10 Or aValori(24) > 10 Then
  Call SetColoreCella(24,RGB(1,147,158),vbWhite)
 End If
 If nx = 2 Then
  For fo = 1 To 4
   Call SetColoreCella(Int(fo),RGB(244,254,177),vbBlack)
  Next
  If aValori(18) > 1000 Then
   Call SetColoreCella(18,RGB(255,197,60),vbBlack)
  End If
  Call SetColoreCella(2,RGB(244,202,34),vbBlack)
  Call SetColoreCella(3,RGB(244,202,34),vbBlack)
  Call SetColoreCella(4,RGB(244,202,34),vbBlack)
  If aValori(4) > max Then
   max = aValori(4)
  End If
  If aValori(3) >= aValori(4) - 6 Then
   Call SetColoreCella(3,RGB(233,108,86),vbWhite)
   Call SetColoreCella(4,RGB(233,108,86),vbWhite)
   For fo = 7 To 16
    If aValori(fo) > 9 Then
     Call SetColoreCella(Int(fo),RGB(233,108,86),vbWhite)
    End If
   Next
  End If
  For fo = 7 To 16
   If aValori(fo) > 8 Then
    Call SetColoreCella(Int(fo),RGB(253,140,244),vbBlack)
   End If
  Next
  If aValori(3) > 15 And aValori(3) < 19 And aValori(19) > 19 And aValori(19) < 85 Then
   Call SetColoreCella(3,RGB(80,253,30),vbBlack)
   Call SetColoreCella(19,RGB(80,253,30),vbBlack)
  End If
  If aValori(27) > 3 Then
   Call SetColoreCella(27,RGB(1,147,158),vbWhite)
  End If
  If aValori(17) > 5 Then
   Call SetColoreCella(17,RGB(252,38,7),vbWhite)
  End If
  If aValori(17) > 8 Then
   For fo = 7 To 16
    Call SetColoreCella(Int(fo),RGB(252,38,7),vbWhite)
   Next
  End If
 End If
 If nx = 1 Then
  For fo = 7 To 16
   If aValori(fo) > 17 Then
    Call SetColoreCella(Int(fo),RGB(147,210,125),vbBlack)
   Else
    Call SetColoreCella(Int(fo),RGB(188,255,159),vbBlack)
   End If
  Next
  If aValori(3) > 17 Then
   Call SetColoreCella(3,RGB(187,205,167),vbBlue)
  End If
  If aValori(3) >= aValori(4) - 6 Then
   Call SetColoreCella(3,RGB(233,108,86),vbWhite)
   Call SetColoreCella(4,RGB(233,108,86),vbWhite)
  End If
  For id = 29 To 33
   If aValori(id) = 0 Then
    Call SetColoreCella(Int(id),RGB(233,108,86),vbWhite)
   End If
  Next
 End If
 '
 GetRitardi = Lancia
End Function
''''------------------------------------------------------------------------------------------------------------------

Codice:

Sub Main
 Dim am
 Dim a
 Dim b
 Dim a1,a2,r,qf
 Dim sfile
 ReDim atitoli(5)
 ReDim avalori(5)
 ' preimposto i titoli delle colonne
 atitoli(1) = " RUOTA      "
 atitoli(2) = " Rit.Attuale"
 atitoli(3) = "        A   m   b   i                        "
 atitoli(4) = " Tot.Ambi "
 atitoli(5) = " Rit.max Gruppo "
 ' ' inizializzo la tabella
 Call InitTabella(atitoli,0,"center",1.8,5,"Courier")
 r = InputBox("Ruota di Elaborazione",,1)
 capogioco = InputBox("Capogioco..",,15)
 ColoreTesto(1)
 Scrivi " situazione Ambi Sulle Ruote con Capogioco e Uguale Ritardo   ",1
 Scrivi " name script AMBOaTUTTE          (Rubino)   ",1
 Scrivi " Capogioco Richiesto....." & capogioco,1
 Scrivi "________________________________________________________________"
 ColoreTesto(0)
 Dim rt(8990)
 ''' calcola ritardo ambi a tutte le ruote
 For x = 1 To 89
  y = x
  For y = y + 1 To 90
   a = Format2(x)
   b = Format2(y)
   am = Format2(x) & Format2(y)
   rt(am) = AmboRitardo(r,a,b,EstrazioneIni,EstrazioneFin)
  Next
 Next
 ''''controlla e mette a video solo gli ambi con capogioco richiesto
 Dim riga(8990)
 For z = 1 To 89
  w = z
  For w = w + 1 To 90
   If Int(capogioco) = z Or Int(capogioco) = w Then
    If w > capogioco Then
     c = Format2(w) & Format2(z)
    Else
     c = Format2(z) & Format2(w)
    End If
    riga(rt(c)) = riga(rt(c)) & Format2(z) & " " & Format2(w) & "   **   "
    ctr = ctr + 1
   End If
  Next
 Next
 Scrivi " Elaborati tot.ambi  " & ctr,1
 For t = 0 To UBound(riga)
  If riga(t) <> "" Then
   avalori(1) = NomeRuota(r)
   avalori(2) = t
   avalori(3) = riga(t)
   ''''''''''------------------------------------------------------------------------------------------------------------------------------------
   '  'scompongo i campi della riga dati divisi da virgola
   ReDim sv(10)
   Call SplitByChar(riga(t),"**",sv)
   avalori(4) = UBound(sv)
   '''' calcola ritardo di gruppo da elencoritardi di ogni ambo nel gruppo
   qf = UBound(sv)
   Call CloseFileHandle(sfile)
   sfile = "C:\temp\GRUPPOAMBI.txt"
   Call EliminaFile(sfile)
   stomax = 0
   For xf = 0 To UBound(sv)
    a1 = capogioco
    a2 = Left(Right(sv(xf),5),2)
    If a2 = capogioco Then a1 = Left(sv(xf),2)
    Getelenco2 a1,a2,r,qf,sfile
   Next
   stomax = Getelenco3(a1,a2,r,qf,sfile)
   avalori(5) = stomax
   '-----------------------------------------------------------------------------------------------------------------------------------------
   Call AddRigaTabella(avalori,Giallo_,"left",5)
   ctr = ctr + 1
   Call SetColoreCella(3,vbWhite,vbBlue)
   Call SetColoreCella(2,vbWhite,vbBlack)
   If avalori(2) > 65 And avalori(2) < 85 Then
    Call SetColoreCella(2,vbRed,vbWhite)
   End If
  End If
 Next
 CreaTabella(2)
End Sub
'------------------------------------------------------------------------------------------------------------------------------------------
Function Getelenco2(a1,a2,r,qf,sfile)
 Dim aretritardi,aretides,tr
 ReDim aN(2)
 ReDim art(1)
 qt = qf
 aN(1) = a1
 aN(2) = a2
 art(1) = r
 Call ElencoRitardi(aN,art,2,EstrazioneIni,EstrazioneFin,aretritardi,aretidestr)
 For x = 1 To UBound(aretritardi) - 1
  za = za + 1
  If Int(aretidestr(x)) < 10 Then nrconc = "000" & aretidestr(x)
  If Int(aretidestr(x)) > 9 And Int(aretidestr(x)) < 100 Then nrconc = "00" & aretidestr(x)
  If Int(aretidestr(x)) > 99 And Int(aretidestr(x)) < 1000 Then nrconc = "0" & aretidestr(x)
  If Int(aretidestr(x)) > 999 Then nrconc = aretidestr(x)
  srecord = nrconc & "," & aretidestr(x) & " " & DataEstrazione(aretidestr(x)) & "," & Format2(aN(1)) & " " & Format2(aN(2)) & "," & NomeRuota(art(1)) & "," & Format2(za)
  Call ScriviFile(sfile,srecord)
 Next
 Getelenco2 = sfile
End Function
'-----------------------------------------------------------------------------------------------------------------------------------------
Function Getelenco3(a1,a2,r,qf,sfile)
 ''''leggo file GRAFICAMBO.TXT per recuperare il ritardo max del gruppo
 Call CloseFileHandle(sfile)
 ReDim rie(8000,6)
 ReDim colpi(8000)
 LeggiRigheFileDiTesto sfile,rie
 Call OrdinaMatrice(rie,- 1,1)
 Dim prec
 prec = EstrazioneFin
 For w = 1 To UBound(rie)
  ReDim aVf(6)
  Call SplitByChar(rie(w),",",aVf)
  ncolpi = Int(prec) - Int(aVf(0))
  If ncolpi > stomax Then stomax = ncolpi
  '''' Scrivi rie(w) & "...." & ncolpi
  prec = Int(aVf(0))
 Next
 ColoreTesto(2)
 '''' Scrivi " storico massimo calcolato in n.colpi..." & stomax,1
 Getelenco3 = stomax
End Function
'-----------------------------------------------------------------------------------------------------------------------------------------

Giulio LG · 21 Maggio 2013

Ritardatari ( Autore Joe91 )

Ritardatari ( Autore Joe91 )

Codice:

Sub Main()

REM MicroBrowser con Evidenziatore By Joe V.3.1 del 18/05/2013
REM ELENCHI ORDINATI DEGLI ESTRATTI x Armando59
REM http://forum.lottoced.com/f12/script-104315/index4.html#post1159871

Sp = " " 'Spazio
Es = EstrazioneFin 'ID-ESTRAZIONE LETTO DALLO SCRIPT.

N = InputBox("Numeri da Cercare ","INSERISCI  I NUMERI ","22")
Nu = Split("0." & N,".")
Scrivi Es & " - " & DataEstrazione(Es),True : Scrivi

For R = 1 To 12 : If R = 11 Then R = 12
Scrivi SiglaRuota(R) & Sp,1,0

For P = 1 To 15
E = NumeroPosRit(Es,R,P)
For X = 1 To UBound(Nu)
If E = CInt(Nu(X)) Then ColoreTesto 2 : Gr = True : T = True
Next
Scrivi Format2(E) & Sp,Gr,0 : ColoreTesto 0 : Gr = False
Next
Scrivi "" 'ACapo

Next

If T = False Then Scrivi : Scrivi "Il Numero " & N & " non è presente.",True

End Sub

Codice:

8692 - 18.05.2013

BA 85 52 78 70 71 47 88 36 04 32 53 72 44 07 74 
CA 68 17 [COLOR=#ff0000]22[/COLOR] 12 56 19 46 29 37 57 83 24 80 86 77 
FI 78 25 07 42 77 82 73 27 51 17 87 89 88 75 31 
GE 36 09 53 11 86 67 34 [COLOR=#ff0000]22[/COLOR] 63 64 54 87 89 85 40 
MI 74 53 37 76 77 85 41 83 88 89 08 71 13 58 84 
NA 70 62 28 36 21 18 63 12 29 16 58 02 83 32 76 
PA 27 59 [COLOR=#ff0000]22[/COLOR] 24 21 34 67 06 15 75 53 78 46 19 80 
RO 35 49 34 78 [COLOR=#ff0000]22[/COLOR] 86 29 82 24 55 89 11 37 03 52 
TO 53 60 [COLOR=#ff0000]22[/COLOR] 16 50 15 62 61 31 90 12 21 19 75 73 
VE 47 41 19 20 71 89 26 34 43 06 23 08 39 13 16 
NZ 20 43 78 26 25 66 01 07 31 83 79 70 77 15 27

Codice:

Sub Main()
'Max_Rit_SM Script By Joe V.SM. (-Chr(9))
Dim n(1),ri(90),m(5),g(5),gp(5),mp(5),rz(1)
i = EstrazioneFin - 200 : f = EstrazioneFin
Scrivi "Estr. N° " & CStr(f) & " del " & CStr(DataEstrazione(f)),1 : Scrivi
Scrivi FormatSpace("Ruota",8) & Space(4) & "-R--I--T--A--R--D--I-",1,0
Scrivi "   -E--S--T--R--A--T--T--I- Rit.Lun",1,1 : Scrivi
Scrivi Space(8),0,0
For X = 1 To 5 : Scrivi FormatSpace(x,4,1) & "°",1,0 : Next
Scrivi Space(2),0,0
For X = 1 To 5 : Scrivi FormatSpace(x,4,1) & "°",1,0 : Next
Scrivi : Scrivi
For ru = 1 To 12 : AvanzamentoElab 0,12,ru
For x = 1 To 90
n(1) = x
rz(1) = Ru
ri(x) = SerieRitardo(i,f,n,rz,1)
Next
For l = 1 To 5
mp(l) = 0
For x = 1 To 90
If ri(x) > mp(l) Then
mp(l) = ri(x)
g(l) = x
End If
Next
ri(g(l)) = 0 'cancella il massimo trovato
Next
For rr = 1 To 50 'Estrazioni precedenti
For x = 1 To 90
n(1) = x
ri(x) = SerieRitardo(i,f - rr,n,rz,1)
Next
For l = 1 To 5
m(l) = 0
For x = 1 To 90
If ri(x) > m(l) Then
m(l) = ri(x)
gp(l) = x
End If
Next
ri(gp(l)) = 0 'cancella il massimo trovato
Next
For x = 1 To 5 'trova gli estratti
For y = 1 To 5
If gp(y) = g(x) Then gp(y) = ""
Next
Next
If gp(1) & gp(2) & gp(3) & gp(4) & gp(5) <> "" Then rm = rr - 1 : rr = 50 'Trovato almeno 1 azzera il ritardo; Esce
If rm > 0 Then gp(1) = "" : gp(2) = "" : gp(3) = "" : gp(4) = "" : gp(5) = "" 'Non è la prima di ritardo cancella il vecchio estratto
Next
Scrivi FormatSpace(NomeRuota(ru),10,0) & FormatSpace(g(1),3,1) & FormatSpace(g(2),5,1) & FormatSpace(g(3),5,1) & FormatSpace(g(4),5,1) & FormatSpace(g(5),5,1),0,0
Scrivi FormatSpace(gp(1),5,1) & FormatSpace(gp(2),5,1) & FormatSpace(gp(3),5,1) & FormatSpace(gp(4),5,1) & FormatSpace(gp(5),5,1),0,0
Scrivi FormatSpace(rm,6,1),1,1
For x = 1 To 5 'cancella i ritardi dei vecchi NON estratti
If gp(x) = "" Then m(x) = ""
Next
Scrivi FormatSpace("Ritardo",10,0) & FormatSpace(mp(1),3,1) & FormatSpace(mp(2),5,1) & FormatSpace(mp(3),5,1) & FormatSpace(mp(4),5,1) & FormatSpace(mp(5),5,1),0,0
Scrivi FormatSpace(m(1),5,1) & FormatSpace(m(2),5,1) & FormatSpace(m(3),5,1) & FormatSpace(m(4),5,1) & FormatSpace(m(5),5,1)
Scrivi
Next
End Sub

Giulio LG · 27 Giugno 2013

Combinazioni Equidistanti Fuori90 ( Da costruire ) Autore joe91

Codice:

Sub Main
 Q = 5 '<=== Inserisci "Quantità" Numeri in Lunghetta
 For P = 1 To 44
  AvanzamentoElab 1,90,P
  'Scrivi String(20,"=") & " PASSO " & Format2(P),1
  For N = 1 To 90
   Stringa = Format2(N) & "."
   For L = 1 To 10
    Stringa = Stringa & Format2(Fuori90(N + L*P)) & "."
   Next
   For LL = 3*Q To 3*Q Step 3
    Scrivi Left(Stringa,LL - 1)
   Next
   'Scrivi
  Next
 Next
End Sub

Codice:

[B]Sub[/B] [B]Main[/B]
Q [B]=[/B] 5 '<--- Modifica
[B]For[/B] D [B]=[/B] 1 [B]To[/B] 1 '<--- Modifica
[B]For[/B] A [B]=[/B] 1 [B]To[/B] 90
Stringa [B]=[/B] ""
[B]For[/B] X [B]=[/B] 1 [B]To[/B] Q
V [B]=[/B] A [B]+[/B] D [B]*[/B](X [B]-[/B] 1)
Stringa [B]=[/B] Stringa [B]&[/B] [B]Format2[/B](V)
[B]If[/B] X [B]<[/B] Q [B]Then[/B] Stringa [B]=[/B] Stringa [B]&[/B] "."
[B]Next[/B]
[B]If[/B] V [B]=<[/B] 90 [B]Then[/B] [B]Scrivi[/B] Stringa : K [B]=[/B] K [B]+[/B] 1
[B]Next[/B]
[B]Next[/B]
[B]Scrivi[/B] : [B]Scrivi[/B] K
[B]End[/B] [B]Sub[/B]

Terzine di Somma ( Da costruire ) Autore Mike58

Codice:

Sub Main()
 Dim num(2),numad(3),k
 For k = 1 To 89
  num(1) = 1 '''Modifica CG
  numad(1) = num(1)
  numad(2) = Fuori90(num(1) + k)
  num(2) = Fuori90(numad(2) + num(1))
  numad(3) = num(2)
  Scrivi StringaNumeri(numad)
 Next
End Sub

CG + Coppie Raddoppiate

Codice:

Sub Main()
Dim num(3),numad(4),k
For k = 1 To 90
num(1) = 90 '''Modifica CG
numad(1) = num(1)
numad(2) = Fuori90(num(1) + k)
num(2) = Fuori90(numad(2) + num(1))
numad(3) = Fuori90(num(2) + k)
numad(4) = num(3)
Scrivi StringaNumeri(numad)
Next
End Sub

Giulio LG · 30 Agosto 2013

FREQUENZA MENSILE > Autore Mike58

Codice:

[B]Sub[/B] [B]Main[/B]
[B]Dim[/B] [B]nu[/B]()
[B]Dim[/B] [B]ru[/B](1)
r [B]=[/B] [B]InputBox[/B]("Quale ruota",,8)
sorte [B]=[/B] [B]CInt[/B]([B]InputBox[/B]("Quale sorte minima verifico x MESI ","SORTE",1))
sortestat [B]=[/B] [B]CInt[/B]([B]InputBox[/B]("QUALE SORTE VERIFICA STATISTICA ","SORTE STATISTICA",1))
Ini [B]=[/B] [B]EstrazioneIni[/B]
fin [B]=[/B] [B]EstrazioneFin[/B] ' range fine estrazioni
Tot [B]=[/B] fin [B]-[/B] Ini [B]+[/B] 1
[B]ru[/B](1) [B]=[/B] r
[B]Call[/B] [B]ScegliNumeri[/B]([B]nu[/B])
[B]Call[/B] [B]StatisticaFormazioneTurbo[/B]([B]nu[/B],[B]ru[/B],sortestat,rerit,reritmax,Incrmax,refre,Ini,fin)
[B]ReDim[/B] [B]atx[/B](12)
[B]atx[/B](1) [B]=[/B] " Comb "
[B]atx[/B](2) [B]=[/B] " Ruota "
[B]atx[/B](3) [B]=[/B] " sorte "
[B]atx[/B](4) [B]=[/B] " Ritardo Att "
[B]atx[/B](5) [B]=[/B] " Rit Max "
[B]atx[/B](6) [B]=[/B] " incr max "
[B]atx[/B](7) [B]=[/B] " Frequenza "
[B]atx[/B](8) [B]=[/B] " Range inizio "
[B]atx[/B](9) [B]=[/B] " Range fine "
[B]atx[/B](10) [B]=[/B] " Estrazioni "
[B]atx[/B](11) [B]=[/B] " Author "
[B]atx[/B](12) [B]=[/B] " Richiesta "
[B]Call[/B] [B]InitTabella[/B]([B]atx[/B],2,,3,5)
[B]atx[/B](1) [B]=[/B] [B]StringaNumeri[/B]([B]nu[/B])
[B]atx[/B](2) [B]=[/B] [B]NomeRuota[/B](r)
[B]atx[/B](3) [B]=[/B] [B]NomeSorte[/B](sortestat)
[B]atx[/B](4) [B]=[/B] rerit
[B]atx[/B](5) [B]=[/B] reritmax
[B]atx[/B](6) [B]=[/B] Incrmax
[B]atx[/B](7) [B]=[/B] refre
[B]atx[/B](8) [B]=[/B] [B]DataEstrazione[/B](Ini)
[B]atx[/B](9) [B]=[/B] [B]DataEstrazione[/B](fin)
[B]atx[/B](10) [B]=[/B] Tot
[B]atx[/B](11) [B]=[/B] " Mike58 "
[B]atx[/B](12) [B]=[/B] " Giulio_LG "
[B]Call[/B] [B]AddRigaTabella[/B]([B]atx[/B],4,,3)
[B]Call[/B] [B]SetColoreCella[/B](11,,7)
[B]Call[/B] [B]SetColoreCella[/B](12,,1)
[B]Call[/B] [B]CreaTabella[/B]()
[B]For[/B] es [B]=[/B] Ini [B]To[/B] fin
[B]Messaggio[/B] "Elaboro estrazioni. . . . . . " [B]&[/B] es [B]&[/B] " * * * * Script By Mike58 * * * * "
[B]Call[/B] [B]AvanzamentoElab[/B](Ini,fin,es)
sf1 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte)
sf2 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte [B]+[/B] 1)
sf3 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte [B]+[/B] 2)
sf4 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte [B]+[/B] 3)
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] m1 [B]=[/B] m1 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] m2 [B]=[/B] m2 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] m3 [B]=[/B] m3 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] m4 [B]=[/B] m4 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] m5 [B]=[/B] m5 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] m6 [B]=[/B] m6 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] m7 [B]=[/B] m7 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] m8 [B]=[/B] m8 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] m9 [B]=[/B] m9 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] m10 [B]=[/B] m10 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] m11 [B]=[/B] m11 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] m12 [B]=[/B] m12 [B]+[/B] sf1
'------------------------------------------------------
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] t1 [B]=[/B] t1 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] t2 [B]=[/B] t2 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] t3 [B]=[/B] t3 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] t4 [B]=[/B] t4 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] t5 [B]=[/B] t5 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] t6 [B]=[/B] t6 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] t7 [B]=[/B] t7 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] t8 [B]=[/B] t8 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] t9 [B]=[/B] t9 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] t10 [B]=[/B] t10 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] t11 [B]=[/B] t11 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] t12 [B]=[/B] t12 [B]+[/B] sf2
'---------------------------------------------------------
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] tt1 [B]=[/B] tt1 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] tt2 [B]=[/B] tt2 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] tt3 [B]=[/B] tt3 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] tt4 [B]=[/B] tt4 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] tt5 [B]=[/B] tt5 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] tt6 [B]=[/B] tt6 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] tt7 [B]=[/B] tt7 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] tt8 [B]=[/B] tt8 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] tt9 [B]=[/B] tt9 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] tt10 [B]=[/B] tt10 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] tt11 [B]=[/B] tt11 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] tt12 [B]=[/B] tt12 [B]+[/B] sf3
'---------------------------------------------------------
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] ttt1 [B]=[/B] ttt1 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] ttt2 [B]=[/B] ttt2 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] ttt3 [B]=[/B] ttt3 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] ttt4 [B]=[/B] ttt4 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] ttt5 [B]=[/B] ttt5 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] ttt6 [B]=[/B] ttt6 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] ttt7 [B]=[/B] ttt7 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] ttt8 [B]=[/B] ttt8 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] ttt9 [B]=[/B] ttt9 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] ttt10 [B]=[/B] ttt10 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] ttt11 [B]=[/B] ttt11 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] ttt12 [B]=[/B] ttt12 [B]+[/B] sf4

'-------------- fine condizione -----------------------------
[B]Next[/B]
'-------- comincio a scrivere i valori ricavati e li scrivo in tabella ----------------
'Scrivi "Numeri in analisi... " & StringaNumeri(nu) & " - Sulla ruota di..." & NomeRuota(r),True,True,3,0,3
'Scrivi "Sorte di verifica minima..." & NomeSorte(sorte),True,True,2,4,3
[B]Scrivi[/B] "Uscita per Mesi su estrazioni n° " [B]&[/B] Tot,[B]True[/B],[B]True[/B],,2,3
[B]Scrivi[/B] ' spazio
'------ scrivo i titoli per la tabella ---------------
[B]ReDim[/B] [B]at[/B](14)
[B]at[/B](1) [B]=[/B] [B]MeseNome[/B](1)
[B]at[/B](2) [B]=[/B] [B]MeseNome[/B](2)
[B]at[/B](3) [B]=[/B] [B]MeseNome[/B](3)
[B]at[/B](4) [B]=[/B] [B]MeseNome[/B](4)
[B]at[/B](5) [B]=[/B] [B]MeseNome[/B](5)
[B]at[/B](6) [B]=[/B] [B]MeseNome[/B](6)
[B]at[/B](7) [B]=[/B] [B]MeseNome[/B](7)
[B]at[/B](8) [B]=[/B] [B]MeseNome[/B](8)
[B]at[/B](9) [B]=[/B] [B]MeseNome[/B](9)
[B]at[/B](10) [B]=[/B] [B]MeseNome[/B](10)
[B]at[/B](11) [B]=[/B] [B]MeseNome[/B](11)
[B]at[/B](12) [B]=[/B] [B]MeseNome[/B](12)
[B]at[/B](13) [B]=[/B] " Totale freq. "
[B]at[/B](14) [B]=[/B] " Sorte "
[B]Call[/B] [B]InitTabella[/B]([B]at[/B],1,,3,5) ' inizializzo tabella dichiarata At,colorefondo(blu),,Size(3),coloreBianco(testo)
'-------- scrivo i valori della presenza nei mesi del numero spia ------------------------------------------------
[B]ReDim[/B] [B]av[/B](14)
[B]av[/B](1) [B]=[/B] " " [B]&[/B] m1
[B]av[/B](2) [B]=[/B] " " [B]&[/B] m2
[B]av[/B](3) [B]=[/B] " " [B]&[/B] m3
[B]av[/B](4) [B]=[/B] " " [B]&[/B] m4
[B]av[/B](5) [B]=[/B] " " [B]&[/B] m5
[B]av[/B](6) [B]=[/B] " " [B]&[/B] m6
[B]av[/B](7) [B]=[/B] " " [B]&[/B] m7
[B]av[/B](8) [B]=[/B] " " [B]&[/B] m8
[B]av[/B](9) [B]=[/B] " " [B]&[/B] m9
[B]av[/B](10) [B]=[/B] " " [B]&[/B] m10
[B]av[/B](11) [B]=[/B] " " [B]&[/B] m11
[B]av[/B](12) [B]=[/B] " " [B]&[/B] m12 'etc.
[B]av[/B](13) [B]=[/B] " " [B]&[/B] m1 [B]+[/B] m2 [B]+[/B] m3 [B]+[/B] m4 [B]+[/B] m5 [B]+[/B] m6 [B]+[/B] m7 [B]+[/B] m8 [B]+[/B] m9 [B]+[/B] m10 [B]+[/B] m11 [B]+[/B] m12
[B]av[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte)
[B]Call[/B] [B]AddRigaTabella[/B]([B]av[/B],,,3)
[B]ReDim[/B] [B]avv[/B](14)
[B]avv[/B](1) [B]=[/B] " " [B]&[/B] t1
[B]avv[/B](2) [B]=[/B] " " [B]&[/B] t2
[B]avv[/B](3) [B]=[/B] " " [B]&[/B] t3
[B]avv[/B](4) [B]=[/B] " " [B]&[/B] t4
[B]avv[/B](5) [B]=[/B] " " [B]&[/B] t5
[B]avv[/B](6) [B]=[/B] " " [B]&[/B] t6
[B]avv[/B](7) [B]=[/B] " " [B]&[/B] t7
[B]avv[/B](8) [B]=[/B] " " [B]&[/B] t8
[B]avv[/B](9) [B]=[/B] " " [B]&[/B] t9
[B]avv[/B](10) [B]=[/B] " " [B]&[/B] t10
[B]avv[/B](11) [B]=[/B] " " [B]&[/B] t11
[B]avv[/B](12) [B]=[/B] " " [B]&[/B] t12 'etc.
[B]avv[/B](13) [B]=[/B] " " [B]&[/B] t1 [B]+[/B] t2 [B]+[/B] t3 [B]+[/B] t4 [B]+[/B] t5 [B]+[/B] t6 [B]+[/B] t7 [B]+[/B] t8 [B]+[/B] t9 [B]+[/B] t10 [B]+[/B] t11 [B]+[/B] t12
[B]avv[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte [B]+[/B] 1)
[B]Call[/B] [B]AddRigaTabella[/B]([B]avv[/B],,,3)
[B]ReDim[/B] [B]avvv[/B](14)
[B]avvv[/B](1) [B]=[/B] " " [B]&[/B] tt1
[B]avvv[/B](2) [B]=[/B] " " [B]&[/B] tt2
[B]avvv[/B](3) [B]=[/B] " " [B]&[/B] tt3
[B]avvv[/B](4) [B]=[/B] " " [B]&[/B] tt4
[B]avvv[/B](5) [B]=[/B] " " [B]&[/B] tt5
[B]avvv[/B](6) [B]=[/B] " " [B]&[/B] tt6
[B]avvv[/B](7) [B]=[/B] " " [B]&[/B] tt7
[B]avvv[/B](8) [B]=[/B] " " [B]&[/B] tt8
[B]avvv[/B](9) [B]=[/B] " " [B]&[/B] tt9
[B]avvv[/B](10) [B]=[/B] " " [B]&[/B] tt10
[B]avvv[/B](11) [B]=[/B] " " [B]&[/B] tt11
[B]avvv[/B](12) [B]=[/B] " " [B]&[/B] tt12 'etc.
[B]avvv[/B](13) [B]=[/B] " " [B]&[/B] tt1 [B]+[/B] tt2 [B]+[/B] tt3 [B]+[/B] tt4 [B]+[/B] tt5 [B]+[/B] tt6 [B]+[/B] tt7 [B]+[/B] tt8 [B]+[/B] tt9 [B]+[/B] tt10 [B]+[/B] tt11 [B]+[/B] tt12
[B]avvv[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte [B]+[/B] 2)
[B]Call[/B] [B]AddRigaTabella[/B]([B]avvv[/B],,,3)
[B]ReDim[/B] [B]avvvv[/B](14)
[B]avvvv[/B](1) [B]=[/B] " " [B]&[/B] ttt1
[B]avvvv[/B](2) [B]=[/B] " " [B]&[/B] ttt2
[B]avvvv[/B](3) [B]=[/B] " " [B]&[/B] ttt3
[B]avvvv[/B](4) [B]=[/B] " " [B]&[/B] ttt4
[B]avvvv[/B](5) [B]=[/B] " " [B]&[/B] ttt5
[B]avvvv[/B](6) [B]=[/B] " " [B]&[/B] ttt6
[B]avvvv[/B](7) [B]=[/B] " " [B]&[/B] ttt7
[B]avvvv[/B](8) [B]=[/B] " " [B]&[/B] ttt8
[B]avvvv[/B](9) [B]=[/B] " " [B]&[/B] ttt9
[B]avvvv[/B](10) [B]=[/B] " " [B]&[/B] ttt10
[B]avvvv[/B](11) [B]=[/B] " " [B]&[/B] ttt11
[B]avvvv[/B](12) [B]=[/B] " " [B]&[/B] ttt12 'etc.
[B]avvvv[/B](13) [B]=[/B] " " [B]&[/B] ttt1 [B]+[/B] ttt2 [B]+[/B] ttt3 [B]+[/B] ttt4 [B]+[/B] ttt5 [B]+[/B] ttt6 [B]+[/B] ttt7 [B]+[/B] ttt8 [B]+[/B] ttt9 [B]+[/B] ttt10 [B]+[/B] ttt11 [B]+[/B] ttt12
[B]avvvv[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte [B]+[/B] 3)
[B]Call[/B] [B]AddRigaTabella[/B]([B]avvvv[/B],,,3)
　
'
[B]Call[/B] [B]CreaTabella[/B](0,0,0,0,1) ' crea tabella in modo verticale
'Call CreaTabella(0,0,0,0,0) ' crea tabella in modo orizzontale
[B]Scrivi[/B]
'Scrivi " Script Listed By Mike58 & Giulio_LG ",True,True,6,0,3
[B]End[/B] [B]Sub[/B]

VERSIONE (B*)

Codice:

[B]Sub[/B] [B]Main[/B]
[B]Dim[/B] [B]nu[/B]()
[B]Dim[/B] [B]ru[/B](1)
r [B]=[/B] [B]InputBox[/B]("Quale ruota",,8)
sorte [B]=[/B] [B]CInt[/B]([B]InputBox[/B]("Quale sorte minima verifico x MESI ","SORTE",2))
sortestat [B]=[/B] [B]CInt[/B]([B]InputBox[/B]("QUALE SORTE VERIFICA STATISTICA ","SORTE STATISTICA",2))
rpp [B]=[/B] [B]CInt[/B]([B]InputBox[/B]("Quanti ritardi precedenti vuoi elencare "," ELENCO RP1 ",10))
Ini [B]=[/B] [B]EstrazioneIni[/B]
fin [B]=[/B] [B]EstrazioneFin[/B] ' range fine estrazioni
Tot [B]=[/B] fin [B]-[/B] Ini [B]+[/B] 1
[B]ru[/B](1) [B]=[/B] r
[B]Call[/B] [B]ScegliNumeri[/B]([B]nu[/B])
[B]Call[/B] [B]StatisticaFormazioneTurbo[/B]([B]nu[/B],[B]ru[/B],sortestat,rerit,reritmax,Incrmax,refre,Ini,fin)
[B]ReDim[/B] [B]atx[/B](12)
[B]atx[/B](1) [B]=[/B] " Comb "
[B]atx[/B](2) [B]=[/B] " Ruota "
[B]atx[/B](3) [B]=[/B] " sorte "
[B]atx[/B](4) [B]=[/B] " Ritardo Att "
[B]atx[/B](5) [B]=[/B] " Rit Max "
[B]atx[/B](6) [B]=[/B] " incr max "
[B]atx[/B](7) [B]=[/B] " Frequenza "
[B]atx[/B](8) [B]=[/B] " Range inizio "
[B]atx[/B](9) [B]=[/B] " Range fine "
[B]atx[/B](10) [B]=[/B] " Estrazioni "
[B]atx[/B](11) [B]=[/B] " Author "
[B]atx[/B](12) [B]=[/B] " Richiesta "
[B]Call[/B] [B]InitTabella[/B]([B]atx[/B],2,,3,5)
[B]atx[/B](1) [B]=[/B] [B]StringaNumeri[/B]([B]nu[/B])
[B]atx[/B](2) [B]=[/B] [B]NomeRuota[/B](r)
[B]atx[/B](3) [B]=[/B] [B]NomeSorte[/B](sortestat)
[B]atx[/B](4) [B]=[/B] rerit
[B]atx[/B](5) [B]=[/B] reritmax
[B]atx[/B](6) [B]=[/B] Incrmax
[B]atx[/B](7) [B]=[/B] refre
[B]atx[/B](8) [B]=[/B] [B]DataEstrazione[/B](Ini)
[B]atx[/B](9) [B]=[/B] [B]DataEstrazione[/B](fin)
[B]atx[/B](10) [B]=[/B] Tot
[B]atx[/B](11) [B]=[/B] " Mike58 "
[B]atx[/B](12) [B]=[/B] " Giulio_LG "
[B]Call[/B] [B]AddRigaTabella[/B]([B]atx[/B],4,,3)
[B]Call[/B] [B]SetColoreCella[/B](11,,7)
[B]Call[/B] [B]SetColoreCella[/B](12,,1)
[B]Call[/B] [B]CreaTabella[/B]()
[B]For[/B] es [B]=[/B] Ini [B]To[/B] fin
[B]Messaggio[/B] "Elaboro estrazioni. . . . . . " [B]&[/B] es [B]&[/B] " * * * * Script By Mike58 * * * * "
[B]Call[/B] [B]AvanzamentoElab[/B](Ini,fin,es)
sf1 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte)
sf2 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte [B]+[/B] 1)
sf3 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte [B]+[/B] 2)
sf4 [B]=[/B] [B]SerieFreqTurbo[/B](es,es,[B]nu[/B],[B]ru[/B],sorte [B]+[/B] 3)
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] m1 [B]=[/B] m1 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] m2 [B]=[/B] m2 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] m3 [B]=[/B] m3 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] m4 [B]=[/B] m4 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] m5 [B]=[/B] m5 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] m6 [B]=[/B] m6 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] m7 [B]=[/B] m7 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] m8 [B]=[/B] m8 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] m9 [B]=[/B] m9 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] m10 [B]=[/B] m10 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] m11 [B]=[/B] m11 [B]+[/B] sf1
[B]If[/B] sf1 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] m12 [B]=[/B] m12 [B]+[/B] sf1
'------------------------------------------------------
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] t1 [B]=[/B] t1 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] t2 [B]=[/B] t2 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] t3 [B]=[/B] t3 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] t4 [B]=[/B] t4 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] t5 [B]=[/B] t5 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] t6 [B]=[/B] t6 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] t7 [B]=[/B] t7 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] t8 [B]=[/B] t8 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] t9 [B]=[/B] t9 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] t10 [B]=[/B] t10 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] t11 [B]=[/B] t11 [B]+[/B] sf2
[B]If[/B] sf2 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] t12 [B]=[/B] t12 [B]+[/B] sf2
'---------------------------------------------------------
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] tt1 [B]=[/B] tt1 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] tt2 [B]=[/B] tt2 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] tt3 [B]=[/B] tt3 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] tt4 [B]=[/B] tt4 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] tt5 [B]=[/B] tt5 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] tt6 [B]=[/B] tt6 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] tt7 [B]=[/B] tt7 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] tt8 [B]=[/B] tt8 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] tt9 [B]=[/B] tt9 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] tt10 [B]=[/B] tt10 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] tt11 [B]=[/B] tt11 [B]+[/B] sf3
[B]If[/B] sf3 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] tt12 [B]=[/B] tt12 [B]+[/B] sf3
'---------------------------------------------------------
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 1 [B]Then[/B] ttt1 [B]=[/B] ttt1 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 2 [B]Then[/B] ttt2 [B]=[/B] ttt2 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 3 [B]Then[/B] ttt3 [B]=[/B] ttt3 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 4 [B]Then[/B] ttt4 [B]=[/B] ttt4 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 5 [B]Then[/B] ttt5 [B]=[/B] ttt5 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 6 [B]Then[/B] ttt6 [B]=[/B] ttt6 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 7 [B]Then[/B] ttt7 [B]=[/B] ttt7 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 8 [B]Then[/B] ttt8 [B]=[/B] ttt8 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 9 [B]Then[/B] ttt9 [B]=[/B] ttt9 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 10 [B]Then[/B] ttt10 [B]=[/B] ttt10 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 11 [B]Then[/B] ttt11 [B]=[/B] ttt11 [B]+[/B] sf4
[B]If[/B] sf4 [B]>[/B] 0 [B]And[/B] [B]Mese[/B](es) [B]=[/B] 12 [B]Then[/B] ttt12 [B]=[/B] ttt12 [B]+[/B] sf4
'-------------- fine condizione -----------------------------
[B]Next[/B]
[B]Scrivi[/B]
[B]Scrivi[/B] "Elenco estrazioni..... max volute " [B]&[/B] rpp,[B]True[/B],[B]True[/B],,1,3
[B]ReDim[/B] [B]ax[/B](6)
[B]ax[/B](1) [B]=[/B] " info estrazione "
[B]ax[/B](2) [B]=[/B] " estratti "
[B]ax[/B](3) [B]=[/B] "Ritardi prec. "
[B]ax[/B](4) [B]=[/B] " Id mese "
[B]ax[/B](5) [B]=[/B] " Nome mese "
[B]ax[/B](6) [B]=[/B] " Ritardo al mese "
[B]Call[/B] [B]InitTabella[/B]([B]ax[/B],3,,3,1)
[B]Call[/B] [B]ElencoRitardi[/B]([B]nu[/B],[B]ru[/B],sortestat,Ini,fin,elrit,elid)
[B]For[/B] k [B]=[/B] [B]UBound[/B](elrit) [B]-[/B] rpp [B]To[/B] [B]UBound[/B](elrit) [B]-[/B] 1
'Scrivi GetInfoEstrazione(elid(k)) & vbTab & " - " & StringaEstratti(elid(k),r) & vbTab & elrit(k) & vbTab & elid(k) & vbTab & Mese(elid(k)),0,0
'Scrivi vbTab & " Ritardo al mese.... " & fin - elid(k)
'Next
[B]ReDim[/B] [B]ax[/B](6)
[B]ax[/B](1) [B]=[/B] [B]GetInfoEstrazione[/B](elid(k)) [B]&[/B] " "
[B]ax[/B](2) [B]=[/B] [B]StringaEstratti[/B](elid(k),r)
[B]ax[/B](3) [B]=[/B] elrit(k)
[B]ax[/B](4) [B]=[/B] [B]Mese[/B](elid(k))
[B]ax[/B](5) [B]=[/B] [B]MeseNome[/B]([B]ax[/B](4)) [B]&[/B] "_ " [B]&[/B] [B]Anno[/B](elid(k))
[B]ax[/B](6) [B]=[/B] fin [B]-[/B] elid(k)
[B]Call[/B] [B]AddRigaTabella[/B]([B]ax[/B],,"center",3)
[B]Call[/B] [B]SetColoreCella[/B](3,,7)
[B]Next[/B]
[B]Call[/B] [B]CreaTabella[/B]()
[B]Scrivi[/B]
[B]Scrivi[/B] "Uscita per Mesi su estrazioni n° " [B]&[/B] Tot,[B]True[/B],[B]True[/B],,2,3
[B]Scrivi[/B] ' spazio
'------ scrivo i titoli per la tabella ---------------
[B]ReDim[/B] [B]at[/B](14)
[B]at[/B](1) [B]=[/B] [B]MeseNome[/B](1)
[B]at[/B](2) [B]=[/B] [B]MeseNome[/B](2)
[B]at[/B](3) [B]=[/B] [B]MeseNome[/B](3)
[B]at[/B](4) [B]=[/B] [B]MeseNome[/B](4)
[B]at[/B](5) [B]=[/B] [B]MeseNome[/B](5)
[B]at[/B](6) [B]=[/B] [B]MeseNome[/B](6)
[B]at[/B](7) [B]=[/B] [B]MeseNome[/B](7)
[B]at[/B](8) [B]=[/B] [B]MeseNome[/B](8)
[B]at[/B](9) [B]=[/B] [B]MeseNome[/B](9)
[B]at[/B](10) [B]=[/B] [B]MeseNome[/B](10)
[B]at[/B](11) [B]=[/B] [B]MeseNome[/B](11)
[B]at[/B](12) [B]=[/B] [B]MeseNome[/B](12)
[B]at[/B](13) [B]=[/B] " Totale freq. "
[B]at[/B](14) [B]=[/B] " Sorte "
[B]Call[/B] [B]InitTabella[/B]([B]at[/B],1,,3,5) ' inizializzo tabella dichiarata At,colorefondo(blu),,Size(3),coloreBianco(testo)
'-------- scrivo i valori della presenza nei mesi del numero spia ------------------------------------------------
[B]ReDim[/B] [B]av[/B](14)
[B]av[/B](1) [B]=[/B] " " [B]&[/B] m1
[B]av[/B](2) [B]=[/B] " " [B]&[/B] m2
[B]av[/B](3) [B]=[/B] " " [B]&[/B] m3
[B]av[/B](4) [B]=[/B] " " [B]&[/B] m4
[B]av[/B](5) [B]=[/B] " " [B]&[/B] m5
[B]av[/B](6) [B]=[/B] " " [B]&[/B] m6
[B]av[/B](7) [B]=[/B] " " [B]&[/B] m7
[B]av[/B](8) [B]=[/B] " " [B]&[/B] m8
[B]av[/B](9) [B]=[/B] " " [B]&[/B] m9
[B]av[/B](10) [B]=[/B] " " [B]&[/B] m10
[B]av[/B](11) [B]=[/B] " " [B]&[/B] m11
[B]av[/B](12) [B]=[/B] " " [B]&[/B] m12 'etc.
[B]av[/B](13) [B]=[/B] " " [B]&[/B] m1 [B]+[/B] m2 [B]+[/B] m3 [B]+[/B] m4 [B]+[/B] m5 [B]+[/B] m6 [B]+[/B] m7 [B]+[/B] m8 [B]+[/B] m9 [B]+[/B] m10 [B]+[/B] m11 [B]+[/B] m12
[B]av[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte)
[B]Call[/B] [B]AddRigaTabella[/B]([B]av[/B],,,3)
[B]ReDim[/B] [B]avv[/B](14)
[B]avv[/B](1) [B]=[/B] " " [B]&[/B] t1
[B]avv[/B](2) [B]=[/B] " " [B]&[/B] t2
[B]avv[/B](3) [B]=[/B] " " [B]&[/B] t3
[B]avv[/B](4) [B]=[/B] " " [B]&[/B] t4
[B]avv[/B](5) [B]=[/B] " " [B]&[/B] t5
[B]avv[/B](6) [B]=[/B] " " [B]&[/B] t6
[B]avv[/B](7) [B]=[/B] " " [B]&[/B] t7
[B]avv[/B](8) [B]=[/B] " " [B]&[/B] t8
[B]avv[/B](9) [B]=[/B] " " [B]&[/B] t9
[B]avv[/B](10) [B]=[/B] " " [B]&[/B] t10
[B]avv[/B](11) [B]=[/B] " " [B]&[/B] t11
[B]avv[/B](12) [B]=[/B] " " [B]&[/B] t12 'etc.
[B]avv[/B](13) [B]=[/B] " " [B]&[/B] t1 [B]+[/B] t2 [B]+[/B] t3 [B]+[/B] t4 [B]+[/B] t5 [B]+[/B] t6 [B]+[/B] t7 [B]+[/B] t8 [B]+[/B] t9 [B]+[/B] t10 [B]+[/B] t11 [B]+[/B] t12
[B]avv[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte [B]+[/B] 1)
[B]Call[/B] [B]AddRigaTabella[/B]([B]avv[/B],,,3)
[B]ReDim[/B] [B]avvv[/B](14)
[B]avvv[/B](1) [B]=[/B] " " [B]&[/B] tt1
[B]avvv[/B](2) [B]=[/B] " " [B]&[/B] tt2
[B]avvv[/B](3) [B]=[/B] " " [B]&[/B] tt3
[B]avvv[/B](4) [B]=[/B] " " [B]&[/B] tt4
[B]avvv[/B](5) [B]=[/B] " " [B]&[/B] tt5
[B]avvv[/B](6) [B]=[/B] " " [B]&[/B] tt6
[B]avvv[/B](7) [B]=[/B] " " [B]&[/B] tt7
[B]avvv[/B](8) [B]=[/B] " " [B]&[/B] tt8
[B]avvv[/B](9) [B]=[/B] " " [B]&[/B] tt9
[B]avvv[/B](10) [B]=[/B] " " [B]&[/B] tt10
[B]avvv[/B](11) [B]=[/B] " " [B]&[/B] tt11
[B]avvv[/B](12) [B]=[/B] " " [B]&[/B] tt12 'etc.
[B]avvv[/B](13) [B]=[/B] " " [B]&[/B] tt1 [B]+[/B] tt2 [B]+[/B] tt3 [B]+[/B] tt4 [B]+[/B] tt5 [B]+[/B] tt6 [B]+[/B] tt7 [B]+[/B] tt8 [B]+[/B] tt9 [B]+[/B] tt10 [B]+[/B] tt11 [B]+[/B] tt12
[B]avvv[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte [B]+[/B] 2)
[B]Call[/B] [B]AddRigaTabella[/B]([B]avvv[/B],,,3)
[B]ReDim[/B] [B]avvvv[/B](14)
[B]avvvv[/B](1) [B]=[/B] " " [B]&[/B] ttt1
[B]avvvv[/B](2) [B]=[/B] " " [B]&[/B] ttt2
[B]avvvv[/B](3) [B]=[/B] " " [B]&[/B] ttt3
[B]avvvv[/B](4) [B]=[/B] " " [B]&[/B] ttt4
[B]avvvv[/B](5) [B]=[/B] " " [B]&[/B] ttt5
[B]avvvv[/B](6) [B]=[/B] " " [B]&[/B] ttt6
[B]avvvv[/B](7) [B]=[/B] " " [B]&[/B] ttt7
[B]avvvv[/B](8) [B]=[/B] " " [B]&[/B] ttt8
[B]avvvv[/B](9) [B]=[/B] " " [B]&[/B] ttt9
[B]avvvv[/B](10) [B]=[/B] " " [B]&[/B] ttt10
[B]avvvv[/B](11) [B]=[/B] " " [B]&[/B] ttt11
[B]avvvv[/B](12) [B]=[/B] " " [B]&[/B] ttt12 'etc.
[B]avvvv[/B](13) [B]=[/B] " " [B]&[/B] ttt1 [B]+[/B] ttt2 [B]+[/B] ttt3 [B]+[/B] ttt4 [B]+[/B] ttt5 [B]+[/B] ttt6 [B]+[/B] ttt7 [B]+[/B] ttt8 [B]+[/B] ttt9 [B]+[/B] ttt10 [B]+[/B] ttt11 [B]+[/B] ttt12
[B]avvvv[/B](14) [B]=[/B] " " [B]&[/B] [B]NomeSorte[/B](sorte [B]+[/B] 3)
[B]Call[/B] [B]AddRigaTabella[/B]([B]avvvv[/B],,,3)
'
'Call CreaTabella(0,0,0,0,1) ' crea tabella in modo verticale
[B]Call[/B] [B]CreaTabella[/B](0,0,0,0,0) ' crea tabella in modo orizzontale
[B]Scrivi[/B]
'Scrivi " Script Listed By Mike58 & Giulio_LG ",True,True,6,0,3
[B]End[/B] [B]Sub[/B]

Giulio LG · 5 Maggio 2014

MartedìGiovedìSabato ---> Autore Mike58

Codice:

Sub Main()
	'Sabato, martedi, giovedi
	Dim nu(1),ru(1)
	num = InputBox("Quale numero cercare ",,90)
	rt = InputBox("Quale ruota ",,1)
	et = CInt(InputBox("Quante estrazioni",,300))
	nu(1) = num
	ru(1) = rt
	For Es = EstrazioneFin - et To EstrazioneFin
		aps = Posizione(es,rt,num)
		If Sabato(es) Then
			If SerieFreq(es,es,nu,ru,1) = 1 Then
				sab = EstrazioneFin - es
				Scrivi DataEstrazione(Es,1) & vbTab & " - " & StringaEstratti(es,rt) & " - Posiz. " & aps
				co = co + 1
			End If
		End If
	Next
	Scrivi
	ColoreTesto 1
	Scrivi "Numero cercato..." & num & " Sulla ruota di..." & NomeRuota(rt) & " è uscito..." & co & " Volte al Sabato " & " è Ritarda da... " & sab,1
	ColoreTesto 0
	Scrivi
	For Es = EstrazioneFin - et To EstrazioneFin
		apg = Posizione(es,rt,num)
		If giovedi(es) Then
			If SerieFreq(es,es,nu,ru,1) = 1 Then
				gio = EstrazioneFin - es
				Scrivi DataEstrazione(Es,1) & vbTab & " - " & StringaEstratti(es,rt) & " - Posiz. " & apg
				co1 = co1 + 1
			End If
		End If
	Next
	Scrivi
	ColoreTesto 1
	Scrivi "Numero cercato..." & num & " Sulla ruota di..." & NomeRuota(rt) & " è uscito..." & co1 & " Volte al giovedì" & " è Ritarda da... " & gio,1
	ColoreTesto 0
	Scrivi
	For Es = EstrazioneFin - et To EstrazioneFin
		apm = Posizione(es,rt,num)
		If martedi(es) Then
			If SerieFreq(es,es,nu,ru,1) = 1 Then
				mar = EstrazioneFin - es
				Scrivi DataEstrazione(Es,1) & vbTab & " - " & StringaEstratti(es,rt) & " - Posiz. " & apm
				co2 = co2 + 1
				sr = SerieRitardo(es,EstrazioneFin,nu,ru,1)
			End If
		End If
	Next
	Scrivi
	ColoreTesto 1
	Scrivi "Numero cercato..." & num & " Sulla ruota di..." & NomeRuota(rt) & " è uscito..." & co2 & " Volte al martedì " & " è Ritarda da... " & mar,1
	ColoreTesto 0
	Scrivi
	tt = co + co1 + co2
	ColoreTesto 2
	Scrivi "Totali di volte uscito.... " & tt & " Ritarda da... " & sr & " Dalla data ultima... " & DataEstrazione(EstrazioneFin - sr,1),1
	ColoreTesto 0
End Sub
Function Sabato(Es)
	Sabato = False
	Data = Replace(DataEstrazione(Es),".","/")
	Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)
	Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann
	If WeekDay(Data) = vbSaturday Then Sabato = True
End Function
Function giovedi(Es)
	giovedi = False
	Data = Replace(DataEstrazione(Es),".","/")
	Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)
	Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann
	If WeekDay(Data) = vbThursday Then giovedi = True
End Function
Function martedi(Es)
	martedi = False
	Data = Replace(DataEstrazione(Es),".","/")
	Mike = Day(Data) : Mes = Month(Data) : Ann = Year(Data)
	Data = Format2(Mike) & "/" & Format2(Mes) & "/" & Ann
	If WeekDay(Data) = vbTuesday Then martedi = True
End Function

Alien. · 6 Maggio 2014

Complimenti bel lavoro.........ma se non vi è come e cosa tirano fuori....restano dei quadri incompresi.

Giulio LG · 19 Aprile 2015

Sviluppo Combinazioni

Codice:

Sub Main
Dim a(5)'NUMERO DA MODIFICARE IN BASE ALLE COMBINAZIONI INSERITE__TABELLA__
Dim Ru(1)
Dim k
Dim nu
ReDim aruote(12)
righe = InputBox("Quante righe vuoi vedere ",,6)
Scrivi "CINQUINA per TERNO (1x1) Ruota di ",1,0,6
If ScegliRuote(aruote) > 0 Then
For k = 1 To UBound(aruote)
If aruote(k) > 0 Then
Scrivi " " & NomeRuota(aruote(k)),1,0,4
End If
Next
End If
Dim posta(2)
posta(1) = 1
posta(2) = 1
nstart = Timer
Fin = EstrazioneFin
Ini = EstrazioneIni
Scrivi NomeRuota(Ru(1)),1,0
Scrivi " dal " & DataEstrazione(Ini) & " al " & DataEstrazione(Fin)
'Scrivi
ReDim atitoli(8)
atitoli(1) = "5"
atitoli(2) = " COMBINAZIONI "
atitoli(3) = "RA "
atitoli(4) = "RS "
atitoli(5) = "FR "
atitoli(6) = " Rp1"
atitoli(7) = " Rp2"
atitoli(8) = " Rp3"
'atitoli(9) = " Rp4"
'atitoli(10) = " Rp5"
'atitoli(11) = " Somma Rp"
Call InitTabella(atitoli,0,,3,5)
a(1) = "2.4.16.18"
a(2) = "2.4.16"
a(3) = "2.4.18"
a(4) = "2.16.18"
a(5) = "4.16.18"
'a(6) = "58-85-03-09"
'a(7) = "04-16-66"
'a(8) = "02-66-88"
'a(9) = "04-16-88"
'a(10) = "16-66-88"
'a(11) = "04-66-88"
'a(12) = "02-04-88"
'a(13) = "02-16-88"
'a(14) = "02-16-66"
'a(15) = "02-04-66"
'a(16) = "02-04-16"
'a(17) = "37-73-33-77-20"
'a(18) = "38-83-33-88-31"
'a(19) = "45-54-44-55-09"
'a(20) = "46-64-44-66-20"
'a(21) = "47-74-44-77-31"
'a(22) = "48-84-44-88-42"
'a(23) = "56-65-55-66-31"
'a(24) = "57-75-55-77-42"
'a(25) = "58-85-55-88-53"
'a(26) = "67-76-66-77-53"
'a(27) = "68-86-66-88-64"
'a(28) = "78-87-77-88-75"
For n = 1 To UBound(a)
n3 = n3 + 1
nu = Split("0." &(a(n)),".")
'sr1 = SerieRitardoTurbo(Ini,fin,nu,aruote,1)', 1 scrive il ritardo dell'estratto
'sr2 = SerieRitardoTurbo(Ini,fin,nu,aruote,2)
sr3 = SerieRitardoTurbo(Ini,fin,nu,aruote,3)
'sr4 = SerieRitardoTurbo(Ini,fin,nu,aruote,4)
'sr5 = SerieRitardoTurbo(Ini,fin,nu,aruote,5)
'st1 = SerieStoricoTurbo(Ini,fin,nu,aruote,1)
'st2 = SerieStoricoTurbo(Ini,fin,nu,aruote,2)
st3 = SerieStoricoTurbo(Ini,fin,nu,aruote,3)
'st4 = SerieStoricoTurbo(Ini,fin,nu,aruote,4)
'st5 = SerieStoricoTurbo(Ini,fin,nu,aruote,5)
'sf1 = SerieFreqTurbo(Ini,Fin,nu,aruote,1)
'sf2 = SerieFreqTurbo(Ini,Fin,nu,aruote,2)
sf3 = SerieFreqTurbo(Ini,Fin,nu,aruote,3)
'sf4 = SerieFreqTurbo(Ini,Fin,nu,aruote,4)
'sf5 = SerieFreqTurbo(Ini,fin,nu,aruote,5)
Call VerificaEsitoTurbo(nu,aruote,fin,2,1,,retesito,,retestratti)
ReDim avalori(8)
avalori(1) = n3
avalori(2) = StringaNumeri(nu)
avalori(3) = sr3
avalori(4) = st3
avalori(5) = sf3
'avalori(6) = RitDiPos(nu,1,aruote)
'avalori(7) = RitDiPos(nu,2,aruote)
'avalori(8) = RitDiPos(nu,3,aruote)
'avalori(9) = RitDiPos(nu,4,aruote)
'avalori(10) = RitDiPos(nu,5,aruote)
ReDim rp(6) 'Numero da modificare in base hai Ritardi Prec. inseriti.
Inizio = EstrazioneIni
fine = EstrazioneFin
'somrit = 0
For z = 1 To 6 'Numero da modificare in base hai Ritardi Prec. inseriti.
rp(z) = SerieRitardoTurbo(Inizio,fine,nu,aruote,3) '1 Rit.Prec ESTRATTO_2 AMBO_3 TERNO ....
fine = fine -(rp(z) + 1)
'somrit = somrit + rp(z)
'Medrit = Int(somrit/z)
Next
' il primo rp(1) = ritardo corrente
avalori(6) = rp(2) ' scrive 1 ritardo precedente
avalori(7) = rp(3)
avalori(8) = rp(4)
'avalori(9) = rp(5)
'avalori(10) = rp(6)
'avalori(11) = rp(7)
Call AddRigaTabella(avalori)
Call SetColoreCella(1,,vbBlue)
Call SetColoreCella(2,,vbRed)' colora la colonna 2 sfondo ciano scritta gialla
Call SetColoreCella(3,4,0)
'Call SetColoreCella(4,4,0)
Call SetColoreCella(5,4,0)
'Call SetColoreCella(11,4,0)
Call SetColoreCella(6,RGB(224,31,20),vbWhite)
Call SetColoreCella(7,RGB(224,31,20),vbWhite)
Call SetColoreCella(8,RGB(224,31,20),vbWhite)
Call SetColoreCella(9,RGB(224,31,20),vbWhite)
Call SetColoreCella(10,RGB(224,31,20),vbWhite)
'If avalori(3) > 20 Then Call SetColoreCella(3,2,vbWhite) 'RA
'If avalori(4) > 100 Then Call SetColoreCella(4,3,0) 'RA
'If avalori(4) > 300 Then Call SetColoreCella(4,2,0) 'RA
'If avalori(5) > 5000 Then Call SetColoreCella(5,2,vbWhite) 'RA
'If avalori(6) > 30 Then Call SetColoreCella(6,2,0) 'RS
'If avalori(7) > 800 Then Call SetColoreCella(7,2,0) 'RS
'If avalori(12) > 100 Then Call SetColoreCella(12,1,vbWhite)
'If avalori(13) > 100 Then Call SetColoreCella(13,1,vbWhite)
'If avalori(14) > 100 Then Call SetColoreCella(14,1,vbWhite)
'If avalori(15) > 100 Then Call SetColoreCella(15,1,vbWhite)
'If avalori(16) > 100 Then Call SetColoreCella(16,1,vbWhite)
'If avalori(12) > 200 Then Call SetColoreCella(12,3,2)
'If avalori(13) > 200 Then Call SetColoreCella(13,3,2)
'If avalori(14) > 200 Then Call SetColoreCella(14,3,2)
'If avalori(15) > 200 Then Call SetColoreCella(15,3,2)
'If avalori(16) > 200 Then Call SetColoreCella(16,3,2)
'If avalori(12) > 300 Then Call SetColoreCella(12,4,2)
'If avalori(13) > 300 Then Call SetColoreCella(13,4,2)
'If avalori(14) > 300 Then Call SetColoreCella(14,4,2)
'If avalori(15) > 300 Then Call SetColoreCella(15,4,2)
'If avalori(16) > 300 Then Call SetColoreCella(16,4,2)
'If avalori(17) > 200 Then Call SetColoreCella(17,7,0)
Next
Scrivi "Tabella Riepilogativa delle combinazioni su : " & Fin - Ini & " Estrazioni.",1
Call CreaTabella(0,,,righe) '(4,,,righe)colonne x ritardo
'Scrivi "Quartina figura5 passo9   "
'Scrivi "1.2.3,4.5.6.7.8.9 > Numeretti"
'Scrivi "88.1.2.3.4.5.6.7.8.9 > Decina per sorti superiori"
'Scrivi "56x11= 616 > TERZINE di GEMELLI  "
'Scrivi "TERZINE di FIGURA 5 "
'Scrivi "6x11= 66 TERZINE"
'Scrivi "Cinquine dispari/pari 9+9= 18x11= 198 CINQINE  "
'Scrivi "Quando si presenta l'AMBO nella cinquina si rimette in GIOCO per 5 COLPI"
'Scrivi "( Ciclo di 5 colpi ) Ritardo Storico 67 ( cicli )"
'Scrivi "( Ciclo di 5 colpi ) Ritardo Attuale 67 ( cicli )"
'Scrivi "OTTINE PARASIMMETRICHE (Gruppo di Quattro)"
'Scrivi "Cinquine composte da vertibili e terzine esponenziali 2.4.16..3.9.81 "
'Scrivi "Coppie pari continuative 2.4/4.6/6.8 ... (45)  "
'Scrivi "27+27= 54x11= 594 CINQUINE "
'Scrivi "Ritardi Storici 7779/BA 7058/BA 6153/PA "
'Scrivi "Ritardo Attuale 8759/TO > MAX in CORSO"
'Scrivi "TERZINA SORTITA 3.9.58 "
'Scrivi "26-35.31 RISTRETTISSIMA"
'Scrivi "33.58.32.34.57.59.78.13"
'Scrivi "44.47.43.45.46.48.89.02"
'Scrivi "55.36.54.56.35.37.10.81"
'Scrivi "66.25.65.67.24.26.21.70"
'Scrivi "77.14.76.78.13.15.32.59"
'Scrivi "88.03.87.89.02.04.43.48"
'Scrivi "BiAmbo 35.36 / 35.37 (2x1) Previsione pubblicata il 06/12/13"
'Scrivi "5.14.77.86 > Integrale > > > Paga 2,6 "
'Scrivi "85.54.21 > > Integrale > > > > Paga 3,5  "
'Scrivi "85.54 > > >  Ristretta > > > > Paga 5,3  "
'Scrivi "CASI:"
'Scrivi "105__1"
'Scrivi "100__1"
'Scrivi "095__0"
'Scrivi "090__4"
'Scrivi "ABBINANMENTI per TERNO > FACOLTATIVO !"
'Scrivi "ALGORITMO :"
'Scrivi "01.10.18.81"
'Scrivi "36.63.38.83"
'Scrivi "54.45.56.65"
'Scrivi "72.27.74.47"
'Scrivi "90.09-02.29"
'Scrivi "12.21.11 ***"
'Scrivi "12.21.13 ***"
'Scrivi "12.21.14 **"
'Scrivi "12.21.15 *"
'Scrivi "12.21.16"
'Scrivi "Decina Continuativa__Terzine per TERNO mai sortite 10x1"
'Scrivi "4.3.2.1.90 Cinquina per TERNO > FACOLTATIVO !"
'Scrivi "GEMELLI TriAmbi continuativi superiori e inferiori al CapoGioco"
'Scrivi "Algoritmo :"
'Scrivi "12.19/12.29  31.39/31.19  51.59/51.19  71.79/71.19"
'Scrivi "13.19/13.39  32.39/32.29  52.59/52.29  72.79/72.29"
'Scrivi "14.19/14.49  34.39/34.49  53.59/53.39  73.79/73.39"
'Scrivi "15.19/15.59  35.39/35.59  54.59/54.49  74.79/74.49"
'Scrivi "16.19/16.69  36.39/36.69  56.59/56.69  75.79/75.59"
'Scrivi "17.19/17.79  37.39/37.79  57.59/57.79  76.79/76.69"
'Scrivi "18.19/18.89  38.39/38.89  58.59/58.89  78.79/78.89"
'Scrivi ""
'Scrivi "21.29/21.19  41.49/41.19  61.69/61.19  81.89/81.19"
'Scrivi "23.29/23.39  42.49/42.29  62.69/62.29  82.89/82.29"
'Scrivi "24.29/24.49  43.49/43.39  63.69/63.39  83.89/83.39"
'Scrivi "25.29/25.59  45.49/45.59  64.69/64.49  84.89/84.49"
'Scrivi "26.29/26.69  46.49/46.69  65.69/65.59  85.89/85.59"
'Scrivi "27.29/27.79  47.49/47.79  67.69/67.79  86.89/86.69"
'Scrivi "28.29/28.89  48.49/48.89  68.69/68.89  87.89/87.79"
'Scrivi "02.86.88"
'Scrivi "03.85.88"
nend = Timer
'Call Scrivi("Tempo di elaborazione : " & FormattaSecondi((nend + 1) - nstart))
End Sub
'Function RitDiPos(nu,pos,aruote)
'ReDim apos(5)
'apos(pos) = True
'RitDiPos = RitardoCombinazioneTurbo(aruote,nu,1,0,apos)
'End Function
Function FormattaSecondi(s)
'Questa Function trasforma il numero di secondi passato come parametro in una stringa
' passando i secondi si ottengono ore  minuti e secondi  in formato hh:mm:ss
' s ---> Numero di secondi da formattare
' ritorna una stringa il cui formato è hh:mm:ss (la function non funziona se in totale abbiamo piu di 99 ore )
Dim hh
Dim Mm
Dim Ss
Dim TimeStr
hh = s \ 3600
Mm =(s Mod 3600) \ 60
Ss = s -((hh * 3600) +(Mm * 60))
TimeStr = Format2(hh) & ":" & Format2(Mm) & ":" & Format2(Ss)
FormattaSecondi = TimeStr
End Function

Roby · 11 Aprile 2016

Cerca

Cerca

SCRIPT x ricerca__AdattatoriSommativi & Altro

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Giulio LG

Banned

Alien.

Advanced Premium Member

Giulio LG

Banned

Roby

Guest

Ultima estrazione Lotto

Ultimi Messaggi