Follow along with the video below to see how to install our site as a web app on your home screen.
Nota: This feature may not be available in some browsers.
Sub main()
'rif. 0902_83a Ro - Ripetuti sul quadro esteso - a ruota
'visualizza il quadro esteso con colorazione dei numeri ripetuti in una frequenza scelta
Dim Vet(),stat(),temp(),nu(),max(12)
fin=EstrazioneFin-(InputBox("Quante es vuoi andare indietro rispetto a Estrazionefin?",,0))
estr= InputBox("Su quante estrazioni vuoi cercare i ripetuti?",,12)
f= CInt(InputBox("Quale frequenza devono avere i ripetuti?",,2)) 'se vuoi con freq maggiori metti l'apice
' davanti a f e sostituisci la riga dove tovi questo segno<<<<<<<<<<<<<<<
ini= fin-(estr-1)
Redim vet(0) : Redim stat(2,0): Redim temp(0): Redim nu(12,0)
For r= 1 To 12
If r<> 11 Then nu(r,0)=r
Next
'-----------------------------
For r= 1 To 11
If r=11 Then r=12
Erase vet : Erase stat
Redim vet(estr*5)
n=0
For es=ini To fin
For p= 1 To 5
n=n+1 : vet(n)=Estratto(es,r,p)
Next
Next
'------------------------
OrdinaMatrice vet
x=UBound(vet)
Redim stat(2,0)
For i= 1 To x
If vet(i)> vet(i-1) Then
co=co+1
Redim preserve stat(2,co)
stat(1,co)=vet(i)
stat(2,co)=1
For y= i+1 To x
If vet(i)=vet(y) Then stat(2,co)=stat(2,co)+1
Next
End If
Next
'------------------------
cu=0 : Redim temp(0)
For i= 1 To co
If stat(2,i)= 2 Then ' <<<<<<<<<< sostituisci con questa If stat(2,i)=> 2 Then
cu=cu+1 : Redim preserve temp(cu)
If cu>maxcu Then maxcu=cu
temp(cu) = stat(1,i)
End If
Next
max(r)=cu
Redim preserve nu(12,maxcu)
For i= 1 To cu : nu(r,i)=temp(i) : Next
Next
'--------------------------------------
Scrivi Chr(10)& " QUADRO ESTESO DEI NUMERI RIPETUTI ",1,0 : ColoreTesto 2
Scrivi "--> "& f &" <-- ",1,0: ColoreTesto 0: Scrivi " VOLTE SU RUOTA UNICA "&CHR(10),1
Scrivi Space(4)& "Ru - Ripetuti ",1
riga=Space(11)
For r= 1 To 12
If max(r)>0 Then riga=riga& Space(6)&SiglaRuota(r)& Space(7)
rigo=""
If max(r)>0 Then
rigo=Space(4)& SiglaRuota(nu(r,0))&space(2)
For t= 1 To max(r)
rigo=rigo& " "& Format2(nu(r,t))
Next
u=u+1
End If
If rigo<>"" Then Scrivi rigo
Next
If u>0 Then
Scrivi
Scrivi riga,1
For es=ini To fin
ColoreTesto 0
Scrivi DataEstrazione(es),0,0:
For r= 1 To 11 : If r= 11 Then r= 12
If max(r)>0 Then
ColoreTesto 0 : Scrivi "|",0,0
If Not Pari(r) Or r= 12 Then cl=2 Else cl=1
For p=1 To 5
For m= 1 To max(r)
ColoreTesto 0
If Estratto(es,r,p)=nu(r,m) Then
ColoreTesto cl
Exit For
End If
Next
If p<5 Then s=" " Else s=""
Scrivi Format2(Estratto(es,r,p))& s ,1,0
Next
If r=12 And p=6 Or r= u And p=6 Then Scrivi Chr(13)
End If
Next
Next
End If
ColoreTesto 2
If u=0 Then Scrivi Chr(10)& " Nessun ripetuto con i parametri impostati "
If u>0 And u <11 Then Scrivi Chr(10)& "NB: le ruote prive di "& f & " ripetuti, non vengono visualizzate"
End Sub