Ciao, io non so fare i listati ma tento di modificarli. Questo dovrebbe fare al caso tuo. (Il listato è di danilo e mod. di ramco). Spero vada bene.
Sub main()
Dim n,t,r1,r2,n1,n2,n3,n4
Dim am(4)
Dim am1(10)
Dim ruote(10)
Dim ruota(10)
Dim posta(5)
Dim poste(5)
poste(2)=2
poste(3)=1
poste(4)=0.5
For n=7400 To EstrazioneFin
Messaggio DataEstrazione
t=1
Do While DISAMBO(n,t,r1,n1,n2,r2,n3,n4)=True
ruota(1)=11
ruote(1)=r1
ruote(2)=r2
s1=Fuori90(n1+n2)
Scrivi
Scrivi String(75,"•"),1
Scrivi " < ambo somma uguale isotopo su 2 ruote consecutive >",1
Scrivi String(75,"-"),1
ColoreTesto 2 : Scrivi DataEstrazione(n,1)&" [ "&siglaruota(r1)&" "&stringaestratti(n,r1)&" ] [ "&siglaruota(r2)&" "&stringaestratti(n,r2)&" ]"
Scrivi "[ "&NomeRuota(r1)&" "&Cint(n1)&" + "&Cint(n2)&" = "&Cint(s1)&" ] [ "& NomeRuota(r2)&" "&Cint(n3)&" + "&Cint(n4)&" = "&Cint(s1)_
&" ] [ stessa somma = "&format2(s1)&" ]"
ColoreTesto 0 : Scrivi String(75,"-"),1
am1(1)=Fuori90(n1+n3)
am1(2)=Fuori90(n2+n4)
am1(3)=Fuori90(n1+n4)
am1(4)=Fuori90(n2+n3)
ImpostaGiocata 1,am1,ruote,poste,9,2
ImpostaGiocata 2,am1,ruota,poste,9,2
Gioca n
t=t+1
Loop
Next
ScriviResoconto 1
ScriviResoconto 2
End Sub
Function DISAMBO(estrazione, tentativo, byref ruota1, byref numero1, byref numero2, byref ruota2, byref numero3, byref numero4)
Dim trovati,r,rr,i,ii,j,jj
trovati=0
For r= 1 To 9
For i= 1 To 4
j=i+1
a=Estratto (estrazione,r,i)
b=Estratto(estrazione,r,j)
c=Fuori90(a+b)
rr=r+1
aa=Estratto(estrazione,rr,i)
bb=Estratto(estrazione,rr,j)
cc=Fuori90(aa+bb)
If c=cc Then
trovati=trovati+1
If trovati=tentativo Then
numero1=a
numero2=b
numero3=aa
numero4=bb
ruota1=r
ruota2=rr
DISAMBO=True
Exit Function
End If
End If
Next
Next
DISAMBO=False
End Function
max