| metto lo script anche per il superenalotto, sempre in uso con spaziometria di LuigiB CODICE [font=Courier]
Option Explicit
Sub Main
''''''superenalotto
Dim Inizio,fine,R,p,n,f,x,elenco,ct,ctf,es,w,q,retcolpi,retestratti,retidestr,dec,j,d,progr,h,conta,nu,ctp,Tot,zero,fin
Dim presenze(90,3)
fin = EstrazioniArchivioSE
fine = InputBox("Estraz.n.",,fin - 35)
Inizio = fine - 15
Scrivi "S u p e r E n a l o t t o ",1
Scrivi "Periodo : dal " & Inizio + 1 & " " & DataEstrazioneSE(Inizio + 1) & " al " & fine & " " & DataEstrazioneSE(fine),1,2,3
Scrivi "Ciclo di 15 Estrazioni"
'''calcola situazione 15 estrazioni
For Inizio = Inizio + 1 To fine
For p = 1 To 6
n = EstrattoSE(Inizio,p)
presenze(n,1) = Format2(n)
presenze(n,2) = presenze(n,2) + 1
Next
Next
Scrivi : Scrivi "Distribuzione dei 90 estratti nelle quantità di presenze nel ciclo ",1
ReDim num(90),Ripe(90,2)
For f = 0 To 10
elenco = " freq." & f & " = "
ct = 0
For x = 1 To 90
If presenze(x,2) = f Then
elenco = elenco & Format2(x) & " "
ct = ct + 1
If f > 0 Then
num(x) = Format2(x)
Ripe(x,2) = Format2(x)
End If
End If
Next
If f > 0 Then ctf = ctf + ct
Scrivi "Qtn. " & Format2(ct) & " : " & elenco
Next
Scrivi "Tot.Numeri aventi Presenze > di zero " & ctf,1,2,3
Scrivi:Scrivi "Tabella Teorica delle Ripetizioni nelle 15 Estrazioni successive"
Scrivi "Num.Estraz. Ripetizione 2/3 2/3 dei 90 Num. "
Scrivi " 01 1,66666667 3,33333333 "
Scrivi " 02 3,33333333 6,66666667 "
Scrivi " 03 5,00000000 10,00000000 "
Scrivi " 04 6,66666667 13,33333333 "
Scrivi " 05 8,33333333 16,66666667 "
Scrivi " 06 10,00000000 20,00000000 "
Scrivi " 07 11,66666667 23,33333333 "
Scrivi " 08 13,33333333 26,66666667 "
Scrivi " 09 15,00000000 30,00000000 "
Scrivi " 10 16,66666667 33,33333333 "
Scrivi " 11 18,33333333 36,66666667 "
Scrivi " 12 20,00000000 40,00000000 "
Scrivi " 13 21,66666667 43,33333333 "
Scrivi " 14 23,33333333 46,66666667 "
Scrivi " 15 25,00000000 50,00000000 "
Scrivi " 16 26,66666667 53,33333333 "
Scrivi " 17 28,33333333 56,66666667 "
Scrivi " 18 30,00000000 60,00000000 "
Scrivi:Scrivi "Esiti avvenuti nei 15 concorsi successivi all'estraz.n. " & fine,1,2,3
Scrivi "Numeri potenzialmente in gioco 2/3 con raffronto alla tabella per Ripetizione 2/3 "
Scrivi "Numeri complessivi con pres. > 0 sono:"
For d = 0 To 8
dec = ""
For j = 1 To 90
If num(j) > 0 And DecinaNaturale(num(j)) = d Then
dec = dec & num(j) & " "
End If
Next
Scrivi dec,1
dec = ""
Next
Scrivi "Totale Numeri da Verificare nei 15 concorsi successivi n. " & ctf,1,2,4
Scrivi
ReDim ar(1)
es = fine
w = 1
progr = 0
Scrivi "R i p e t i z i o n i non Univoche ",1,2,4
For q = 1 To 15
ar(1) = R
Call VerificaEsitoSE(num,es + q,1,w,,retcolpi,retestratti,retidestr)
If retestratti <> "" Then
conta = 0
If Mid(retestratti,1,2) <> ".." Then
nu = Mid(retestratti,1,2)
conta = conta + 1
Ripe(nu,1) = Ripe(nu,1) + 1
End If
If Mid(retestratti,4,2) <> ".." Then
nu = Mid(retestratti,4,2)
conta = conta + 1
Ripe(nu,1) = Ripe(nu,1) + 1
End If
If Mid(retestratti,7,2) <> ".." Then
nu = Mid(retestratti,7,2)
conta = conta + 1
Ripe(nu,1) = Ripe(nu,1) + 1
End If
If Mid(retestratti,10,2) <> ".." Then
nu = Mid(retestratti,10,2)
conta = conta + 1
Ripe(nu,1) = Ripe(nu,1) + 1
End If
If Mid(retestratti,13,2) <> ".." Then
nu = Mid(retestratti,13,2)
conta = conta + 1
Ripe(nu,1) = Ripe(nu,1) + 1
End If
If Mid(retestratti,16,2) <> ".." Then
nu = Mid(retestratti,16,2)
conta = conta + 1
Ripe(nu,1) = Ripe(nu,1) + 1
End If
progr = progr + conta
Scrivi retidestr & " " & Mid(retestratti,1,17) & " ncolpo " & retcolpi & " Ripet. qtaProg. " & Format2(progr) & " Ripet." & conta
End If
Next
Scrivi:Scrivi "Riepilogo delle ripetizioni avvenute e per fascia di presenza ",1,2,3
For f = 0 To 10
elenco = " Pres." & f & " = "
ctp = 0
For x = 1 To 90
If Ripe(x,2) > 0 Then
If Ripe(x,1) = f Then
elenco = elenco & Format2(x) & " "
ctp = ctp + 1
End If
End If
Next
If f = 0 Then
Scrivi "Qtn. " & Format2(ctp) & " : " & elenco
zero = ctp
End If
If f > 0 Then Scrivi "Qtn. " & Format2(ctp) & " : " & elenco
Tot = Tot + ctp * f
Next
Scrivi "Tra i numeri in esame di ripetizione n. " & ctf,1,2,4
Scrivi "Numeri senza Ripetizione n. " & zero,1
Scrivi "Ripetizioni avvenute Totale n. " & Tot,1
Scrivi "Numeri con almeno 1 Ripetizione sono n. " & Tot - zero,1
End Sub
[/font]
è per Genios o Silop , sempre che abbiano installato sul loro computer TwinBasic intorno alla vers.292, quindi un po vecchiotta rispetto a quella attuale.
il programmino "exe" è da mettere nella cartella dove hanno scaricato il programma BIAMBI di LuigiB
se mi fate sapere se funziona, grazie. |
