alpacino27
Junior Member
Salve a tutti!
Cerco da diversi giorni di modificare un listato trovato in rete.Non riesco in quanto neofita.Tale listato,cerca due numeri su una ruota e uno su un'altra ruota.A me servirebbe che , il terzo numero sia in posizione isotopa.Inoltre vorrei aggiungere alla ricerca,i terni più frequenti.Vi ringrazio anticipatamente per l'aiuto.
Questo è il listato:
Sub main()
Dim n(3),x(3),a1(3),xc(3),ru(2),nu1(4005,4),nn(2)
Dim nu2(4005,4),nn1(6),nu3(90,3),nn2(2),nu4(90,3),nx(90)
ab="Digita Tre numeri distanziati dal punto(.)"
aa=InputBox(ab,"Numeri di Ricerca","22.33.55")
aa="0."&aa
s=Split(aa,".")
n(1)=CInt(s(1))
n(2)=CInt(s(2))
n(3)=CInt(s(3))
Erase nu1
Erase nu2
Erase nu3
Erase nu4
fin=EstrazioneFin
ini=CInt (InputBox ("Da che Estrazione Iniziamo?(3575 dal 1939 ; 6584 doppia estr.; 7454 3^Estr.)","ESTRAZIONE",7454))
'3575 estrazione 1939<----->> 6584 <<inizio doppia estrazione <<< 3° estrazione 7454
ww=CInt (InputBox ("Quante Estrazioni successive utilizziamo per il controllo?","SUCCESSIVE",12))
cnt=CInt (InputBox ("Nella Visualizzazione quante Formazioni vuoi vedere ?","FORMAZIONI",20))
sru=CInt (InputBox ("VUOI CONTROLLARE TUTTE LE RUOTE ? (1=SI ; 2=NO)","SCELTA RUOTE",1))
If sru=1 Then
casi=0
For es=ini To fin
Messaggio " Numeri Spia "& StringaNumeri
&" Data "& DataEstrazione(es)
For r=1 To 10 'Qui si cambia per controllare una ruota particolare 10 to 10 VE, o TUTTE 1 to 10
x(1)=n(1)
x(2)=n(2)
x(3)=n(3)
For p=1 To 4
a=Estratto (es,r,p)
If a=x(1) Or a=x(2) Or a=x(3) Then
For q=p+1 To 5
b=Estratto (es,r,q)
If b=x(1) Or b=x(2) Or b=x(3) Then
If a=x(1) Or b=x(1) Then x(1)=0
If a=x(2) Or b=x(2) Then x(2)=0
If a=x(3) Or b=x(3) Then x(3)=0
OrdinaMatrice x,-1
If x(1)=0 Then ColoreTesto 2 : Call informa(es,r,a,b,0,0)
For r1=1 To 10 'Qui si cambia per controllare una ruota particolare 10 to 10 VE, o TUTTE 1 to 10
If r1<>r Then
pq=Posizione(es,r1,x(1))
If pq>0 Then
casi=casi+1
ColoreTesto 0 : Scrivi casi&")",0 : Call informa(es,r,a,b,r1,x(1))
ess=es+ww
If ess>fin Then ess=fin End If
co=0
For x1=1 To 89
For y1=x1+1 To 90
co=co+1
nu1(co,1)=co : nu1(co,2)=x1 : nu1(co,3)=y1
nn(1)=x1 : nn(2)=y1 : ru(1)=r : ru(2)=r1
k1=SerieFreq (es+1,ess,nn,ru,2)
nu1(co,4)=nu1(co,4)+ k1
nu2(co,1)=co : nu2(co,2)=x1 : nu2(co,3)=y1
nn1(1)=x1 : nn1(2)=y1 : ru(1)=r : ru(2)=r1
k2=SerieFreq (es+1,ess,nn1,ru,2)
If k2>1 Then k2=1
nu2(co,4)=nu2(co,4)+ k2
Next
Next
co=0
For xx=1 To 90
co=co+1
nu3(co,1)=co : nu3(co,2)=xx
nn2(1)=xx : ru(1)=r : ru(2)=r1
k3=SerieFreq (es+1,ess,nn2,ru,1)
If k3>1 Then k3=1
nu3(co,3)=nu3(co,3)+ k3
nu4(co,1)=co : nu4(co,2)=xx
nn2(1)=xx : ru(1)=r : ru(2)=r1
k4=SerieFreq (es+1,ess,nn2,ru,1)
nu4(co,3)=nu4(co,3)+ k4
Next
End If
End If
Next
End If
Next
End If
Next
Next
Next
Else
If sru=2 Then
nrt=InputBox("DIGITA LE DUE RUOTE DI RICERCA [1=BA ; 2=CA...](separate dal (.))","RUOTE RICERCA","4.9")
nrt="0."&nrt
rts=Split(nrt,".")
rq1=CInt(rts(1))
rq2=CInt(rts(2))
For es=ini To fin
Messaggio " Numeri Spia "& StringaNumeri&" Data "& DataEstrazione(es)
For r=1 To 10
If r=rq1 Or r=rq2 Then
x(1)=n(1)
x(2)=n(2)
x(3)=n(3)
For p=1 To 4
a=Estratto (es,r,p)
If a=x(1) Or a=x(2) Or a=x(3) Then
For q=p+1 To 5
b=Estratto (es,r,q)
If b=x(1) Or b=x(2) Or b=x(3) Then
If a=x(1) Or b=x(1) Then x(1)=0
If a=x(2) Or b=x(2) Then x(2)=0
If a=x(3) Or b=x(3) Then x(3)=0
OrdinaMatrice x,-1
If x(1)=0 Then ColoreTesto 2 : Call informa(es,r,a,b,0,0)
For r1=1 To 10
If r1<>r Then
If r1=rq1 Or r1=rq2 Then
pq=Posizione(es,r1,x(1))
If pq>0 Then
casi=casi+1
ColoreTesto 0 : Scrivi casi&")",0 : Call informa(es,r,a,b,r1,x(1))
ess=es+ww
If ess>fin Then ess=fin End If
co=0
For x1=1 To 89
For y1=x1+1 To 90
co=co+1
nu1(co,1)=co : nu1(co,2)=x1 : nu1(co,3)=y1
nn(1)=x1 : nn(2)=y1 : ru(1)=r : ru(2)=r1
k1=SerieFreq (es+1,ess,nn,ru,2)
nu1(co,4)=nu1(co,4)+ k1
nu2(co,1)=co : nu2(co,2)=x1 : nu2(co,3)=y1
nn1(1)=x1 : nn1(2)=y1 : ru(1)=r : ru(2)=r1
k2=SerieFreq (es+1,ess,nn1,ru,2)
If k2>1 Then k2
Cerco da diversi giorni di modificare un listato trovato in rete.Non riesco in quanto neofita.Tale listato,cerca due numeri su una ruota e uno su un'altra ruota.A me servirebbe che , il terzo numero sia in posizione isotopa.Inoltre vorrei aggiungere alla ricerca,i terni più frequenti.Vi ringrazio anticipatamente per l'aiuto.
Questo è il listato:
Sub main()
Dim n(3),x(3),a1(3),xc(3),ru(2),nu1(4005,4),nn(2)
Dim nu2(4005,4),nn1(6),nu3(90,3),nn2(2),nu4(90,3),nx(90)
ab="Digita Tre numeri distanziati dal punto(.)"
aa=InputBox(ab,"Numeri di Ricerca","22.33.55")
aa="0."&aa
s=Split(aa,".")
n(1)=CInt(s(1))
n(2)=CInt(s(2))
n(3)=CInt(s(3))
Erase nu1
Erase nu2
Erase nu3
Erase nu4
fin=EstrazioneFin
ini=CInt (InputBox ("Da che Estrazione Iniziamo?(3575 dal 1939 ; 6584 doppia estr.; 7454 3^Estr.)","ESTRAZIONE",7454))
'3575 estrazione 1939<----->> 6584 <<inizio doppia estrazione <<< 3° estrazione 7454
ww=CInt (InputBox ("Quante Estrazioni successive utilizziamo per il controllo?","SUCCESSIVE",12))
cnt=CInt (InputBox ("Nella Visualizzazione quante Formazioni vuoi vedere ?","FORMAZIONI",20))
sru=CInt (InputBox ("VUOI CONTROLLARE TUTTE LE RUOTE ? (1=SI ; 2=NO)","SCELTA RUOTE",1))
If sru=1 Then
casi=0
For es=ini To fin
Messaggio " Numeri Spia "& StringaNumeri
&" Data "& DataEstrazione(es)For r=1 To 10 'Qui si cambia per controllare una ruota particolare 10 to 10 VE, o TUTTE 1 to 10
x(1)=n(1)
x(2)=n(2)
x(3)=n(3)
For p=1 To 4
a=Estratto (es,r,p)
If a=x(1) Or a=x(2) Or a=x(3) Then
For q=p+1 To 5
b=Estratto (es,r,q)
If b=x(1) Or b=x(2) Or b=x(3) Then
If a=x(1) Or b=x(1) Then x(1)=0
If a=x(2) Or b=x(2) Then x(2)=0
If a=x(3) Or b=x(3) Then x(3)=0
OrdinaMatrice x,-1
If x(1)=0 Then ColoreTesto 2 : Call informa(es,r,a,b,0,0)
For r1=1 To 10 'Qui si cambia per controllare una ruota particolare 10 to 10 VE, o TUTTE 1 to 10
If r1<>r Then
pq=Posizione(es,r1,x(1))
If pq>0 Then
casi=casi+1
ColoreTesto 0 : Scrivi casi&")",0 : Call informa(es,r,a,b,r1,x(1))
ess=es+ww
If ess>fin Then ess=fin End If
co=0
For x1=1 To 89
For y1=x1+1 To 90
co=co+1
nu1(co,1)=co : nu1(co,2)=x1 : nu1(co,3)=y1
nn(1)=x1 : nn(2)=y1 : ru(1)=r : ru(2)=r1
k1=SerieFreq (es+1,ess,nn,ru,2)
nu1(co,4)=nu1(co,4)+ k1
nu2(co,1)=co : nu2(co,2)=x1 : nu2(co,3)=y1
nn1(1)=x1 : nn1(2)=y1 : ru(1)=r : ru(2)=r1
k2=SerieFreq (es+1,ess,nn1,ru,2)
If k2>1 Then k2=1
nu2(co,4)=nu2(co,4)+ k2
Next
Next
co=0
For xx=1 To 90
co=co+1
nu3(co,1)=co : nu3(co,2)=xx
nn2(1)=xx : ru(1)=r : ru(2)=r1
k3=SerieFreq (es+1,ess,nn2,ru,1)
If k3>1 Then k3=1
nu3(co,3)=nu3(co,3)+ k3
nu4(co,1)=co : nu4(co,2)=xx
nn2(1)=xx : ru(1)=r : ru(2)=r1
k4=SerieFreq (es+1,ess,nn2,ru,1)
nu4(co,3)=nu4(co,3)+ k4
Next
End If
End If
Next
End If
Next
End If
Next
Next
Next
Else
If sru=2 Then
nrt=InputBox("DIGITA LE DUE RUOTE DI RICERCA [1=BA ; 2=CA...](separate dal (.))","RUOTE RICERCA","4.9")
nrt="0."&nrt
rts=Split(nrt,".")
rq1=CInt(rts(1))
rq2=CInt(rts(2))
For es=ini To fin
Messaggio " Numeri Spia "& StringaNumeri
&" Data "& DataEstrazione(es)For r=1 To 10
If r=rq1 Or r=rq2 Then
x(1)=n(1)
x(2)=n(2)
x(3)=n(3)
For p=1 To 4
a=Estratto (es,r,p)
If a=x(1) Or a=x(2) Or a=x(3) Then
For q=p+1 To 5
b=Estratto (es,r,q)
If b=x(1) Or b=x(2) Or b=x(3) Then
If a=x(1) Or b=x(1) Then x(1)=0
If a=x(2) Or b=x(2) Then x(2)=0
If a=x(3) Or b=x(3) Then x(3)=0
OrdinaMatrice x,-1
If x(1)=0 Then ColoreTesto 2 : Call informa(es,r,a,b,0,0)
For r1=1 To 10
If r1<>r Then
If r1=rq1 Or r1=rq2 Then
pq=Posizione(es,r1,x(1))
If pq>0 Then
casi=casi+1
ColoreTesto 0 : Scrivi casi&")",0 : Call informa(es,r,a,b,r1,x(1))
ess=es+ww
If ess>fin Then ess=fin End If
co=0
For x1=1 To 89
For y1=x1+1 To 90
co=co+1
nu1(co,1)=co : nu1(co,2)=x1 : nu1(co,3)=y1
nn(1)=x1 : nn(2)=y1 : ru(1)=r : ru(2)=r1
k1=SerieFreq (es+1,ess,nn,ru,2)
nu1(co,4)=nu1(co,4)+ k1
nu2(co,1)=co : nu2(co,2)=x1 : nu2(co,3)=y1
nn1(1)=x1 : nn1(2)=y1 : ru(1)=r : ru(2)=r1
k2=SerieFreq (es+1,ess,nn1,ru,2)
If k2>1 Then k2
