Possibile modifica ...

[Fortuna_68]

Ciao forum , vi chiedo se potete modificare questo script aggiungendo un'altra ruota di ricerca quindi operare su due ruote e non solo su una , grazie ( programma L8+ 6.1 )
Sub main()
Dim som(5,5,90)
Dim estr(2,5)
Dim val(5,5,90)
Dim amb(90)
r2=InputBox("Inserisci la ruota su cui effettuare la ricerca(1-10):",,1)
es=InputBox("Inserisci 0 per l'ultima, 1 la prima, 2 la seconda, ecc. (0-8):",,0)
nmc=InputBox("Numero di mesi da considerare:",,27)
perc=InputBox("Inserisci la percentuale (0-100):",,90)
ncg=InputBox("Inserisci il numero di colpi(0 per un mese):",,12)
ultest=9389 ' qui ogni ultima estrazione aggiorna manualmente il numero dell'ultima
n=EstrazioneFin
z=0
trovato=False
While z<eval(nmc)
' Attenzione questa sotto deve essere una sola riga
If (((eval(es)=0) And (n=ultest)) Or ((IndiceMensile(n)=eval(es) And (eval(es)>0)) Or ((IndiceMensile(n+1)=1) And (eval(es)=0)))) Then
' fine della riga
z=z+1
End If
n=n-1
Wend
nn=n+1
For i=1 To 90
amb(i)=0
Next
If eval(es)=0 Then
s="All'ultima"
Else
s="Alla "+es
End If
s=s+"° estrazione del mese per "
If eval(ncg)=0 Then
s=s+"un mese:"
Else
If eval(ncg)=1 Then
s=s+ncg+" colpo:"
Else
s=s+ncg+" colpi:"
End If
End If
Scrivi s
Scrivi "Statistica dal "+DataEstrazione(nn)+" al "+DataEstrazione(EstrazioneFin)
For ru1=1 To 10
For ru2=ru1 To 10
Messaggio " Elaboro la ruota n° "&CInt(ru1)&" con la n° "&CInt(ru2)
z=0
For i=1 To 5
For l=1 To 5
For j=1 To 90
som(i,l,j)=0
val(i,l,j)=True
Next
Next
Next
For j=1 To 2
For i=1 To 5
estr(j,i)=0
Next
Next
valido=False
For n=nn To EstrazioneFin
If eval(es)=0 Then m=n+1 Else m=n End If
' Attenzione questa sotto deve essere una sola riga
If (((es=0) And (n=ultest)) Or ((IndiceMensile(m)=eval(es) And (eval(es)>0)) Or ((IndiceMensile(m)=1) And (eval(es)=0)))) Then
' fine della riga
z=z+1
For i=1 To 5
estr(1,i)=Estratto(n,ru1,i)
estr(2,i)=Estratto(n,ru2,i)
Next
For i=1 To 5
For l=1 To 5
For j=1 To 90
val(i,l,j)=True
Next
Next
Next
If eval(ncg)=0 Then
k2=9
If (IndiceMensile(n+8)=eval(es)) Then
k2=8
End If
Else
k2=eval(ncg)
End If
k3=n+k2
If k3 > EstrazioneFin Then k3 = EstrazioneFin
For nv=n+1 To k3
For i=1 To 5
For j=1 To 5
For l=1 To 5
k=Estratto(nv,r2,i)-estr(1,j)-estr(2,l)
While k<=0
k=k+90
Wend
If val(j,l,k)=True Then
som(j,l,k)=som(j,l,k)+1
val(j,l,k)=False
End If
Next
Next
Next
Next
End If
Next
For i=1 To 5
For l=1 To 5
For j=1 To 90
zz=Int((z/100)*perc)
s=CStr(eval(i))+"° di "+FormatSpace(NomeRuota(ru1),8)+" + "+CStr(eval(l))+"° di "&_
FormatSpace(NomeRuota(ru2),8)+" + "+FormatSpace(CStr(eval(j)),2)
s=s+" su "+NomeRuota(r2)+" "+CStr(som(i,l,j))+" su "+CStr(eval(z))+": "&_
FormatSpace(CStr(Fuori90(eval(estr(1,i)+estr(2,l)+j))),2)
If val(i,l,j)=True Then s=s+" in corso" Else s=s+" già uscito"
If (som(i,l,j)>=zz) Then
If (Not(ru1=ru2) Or ((ru1=ru2) And (i<l))) Then
Scrivi s
amb(Fuori90(eval(estr(1,i)+estr(2,l)+j)))=amb(Fuori90(eval(estr(1,i)+estr(2,l)+j)))+1
End If
End If
Next
Next
Next
Next
For i=1 To 90
If (amb(i)>1) Then Scrivi CStr(eval(i))+": previsto da "+CStr(eval(amb(i)))+" sistemi"
Next
Next
End Sub

[Master]

Ciao a tutti
Ho trovato questo in archivio, non l'ho mai usato e non so se è corretto
spero che ti sia utile
Buona serata

Codice: Seleziona tutto

Sub Main()
   Dim som(5,5,90)
   Dim estr(2,5)
   Dim Val(5,5,90)
   Dim amb(90)
   r2 = InputBox("Inserisci la ruota su cui effettuare la ricerca(1-10):",,1)
   r3 = InputBox("Inserisci la ruota su cui effettuare la ricerca(1-10):",,2)
   es = InputBox("Inserisci 0 per l'ultima, 1 la prima, 2 la seconda, ecc. (0-8):",,0)
   nmc = InputBox("Numero di mesi da considerare:",,27)
   perc = InputBox("Inserisci la percentuale (10-90):",,90)
   k2 = InputBox("Numero colpi ( 2-9 ): ",,12)
   ultest = 9389 ' qui ogni ultima estrazione aggiorna manualmente il numero dell'ultima
   n = EstrazioneFin
   z = 0
   trovato = False
   While z < eval(nmc)
      'Attenzione questa sotto deve essere una sola riga
      If(((eval(es) = 0) And(n = ultest)) Or((IndiceMensile(n) = eval(es) And(eval(es) > 0)) Or((IndiceMensile(n + 1) = 1) And(eval(es) = 0)))) Then
         'fine della riga
         z = z + 1
      End If
      n = n - 1
   Wend
   nn = n + 1
   For i = 1 To 90
      amb(i) = 0
   Next
   If eval(es) = 0 Then
      Scrivi "All'ultima del mese - per max : " & k2 & " colpi"
   Else
      Scrivi "Alla " + es + "° del mese - per max : " & k2 & " colpi"
   End If
   Scrivi "Statistica dal " + DataEstrazione(nn) + " al " + DataEstrazione(EstrazioneFin)
   For ru1 = 1 To 10
      For ru2 = ru1 To 10
         Messaggio " Elaboro la ruota n° " & CInt(ru1) & " con la n° " & CInt(ru2)
         z = 0
         For i = 1 To 5
            For l = 1 To 5
               For j = 1 To 90
                  som(i,l,j) = 0
                  Val(i,l,j) = True
               Next
            Next
         Next
         For j = 1 To 2
            For i = 1 To 5
               estr(j,i) = 0
            Next
         Next
         For n = nn To EstrazioneFin
            If eval(es) = 0 Then m = n + 1 Else m = n End If
            'Attenzione questa sotto deve essere una sola riga
            If(((es = 0) And(n = ultest)) Or((IndiceMensile(m) = eval(es) And(eval(es) > 0)) Or((IndiceMensile(m) = 1) And(eval(es) = 0)))) Then
               'fine della riga
               z = z + 1
               For i = 1 To 5
                  estr(1,i) = Estratto(n,ru1,i)
                  estr(2,i) = Estratto(n,ru2,i)
               Next
               For i = 1 To 5
                  For l = 1 To 5
                     For j = 1 To 90
                        Val(i,l,j) = True
                     Next
                  Next
               Next
               If(IndiceMensile(n + 8) = eval(es)) Then k2 = 8 End If
               k3 = n + k2
               If k3 > EstrazioneFin Then k3 = EstrazioneFin
               For nv = n + 1 To k3
                  For i = 1 To 5
                     For j = 1 To 5
                        For l = 1 To 5
                           k = Estratto(nv,r2,i) - estr(1,j) - estr(2,l)
                           kk = Estratto(nv,r3,i) - estr(1,j) - estr(2,l)
                           While k <= 0
                              k = k + 90
                           Wend
                           While kk <= 0
                              kk = kk + 90
                           Wend
                           If Val(j,l,k) = True Then
                              som(j,l,k) = som(j,l,k) + 1
                              Val(j,l,k) = False
                           End If
                           If Val(j,l,kk) = True Then
                              som(j,l,kk) = som(j,l,kk) + 1
                              Val(j,l,kk) = False
                           End If
                        Next
                     Next
                  Next
               Next
            End If
         Next
         For i = 1 To 5
            For l = 1 To 5
               For j = 1 To 90
                  zz =(z/100)*perc
                  s = CStr(eval(i)) + "° di " + FormatSpace(NomeRuota(ru1),8) + " + " + CStr(eval(l)) + "° di " + FormatSpace(NomeRuota(ru2),8) + " + " + FormatSpace(CStr(eval(j)),2)
                  s = s + " su " + NomeRuota(r2) + " e " + NomeRuota(r3) + "   è uscito " + CStr(som(i,l,j)) + " volte su " + CStr(eval(z))'+": "+FormatSpace(CStr(Fuori90(eval(estr(1,i)+estr(2,l)+j))),2)
                  If Val(i,l,j) = True Then s = s + " in corso" Else s = s + " già uscito"
                  If(som(i,l,j) >= zz) Then
                     If(Not(ru1 = ru2) Or((ru1 = ru2) And(i < l))) Then
                        Scrivi s
                        amb(Fuori90(eval(estr(1,i) + estr(2,l) + j))) = amb(Fuori90(eval(estr(1,i) + estr(2,l) + j))) + 1
                     End If
                  End If
               Next
            Next
         Next
      Next
   Next
   For i = 1 To 90
      If(amb(i) > 2) Then Scrivi CStr(eval(i)) + ": previsto da " + CStr(eval(amb(i))) + " sistemi"
   Next
End Sub
 

[Fortuna_68]

Grazie mille Master , è perfetto .
Se posso azzardare un'ulteriore richiesta : con calma , se avrai tempo e voglia , potresti aggiungere un secondo capogioco a questo script ?
Al passaggio del " Capogioco 0=automatico " , quindi con la scelta volontaria o meno del capogioco , è possibile che ne ricerchi automaticamente o che lo imposti io un altro in modo da ricavare 2 capogiochi e 4 abbinamenti in tutto ?
Grazie ancora .

Sub main()
Dim ruote(11)
Dim numeri(90),pres(90)
Dim ncicli
Dim cicli
Dim stringa
Dim ns(10)
Dim r1,r2,es,e1,estr1,estr2,cc,decmax,cadmax,nmax,n,nf,np,ff,scad,sdec,conta,nsp,cpg
cicli=CLng(InputBox ("Quanti cicli vuoi analizzare ?"))
ncicli=CLng(InputBox ("Di quante estrazioni ?"))
r1=CLng(InputBox ("Ruota numero 1: (1=Bari 2=Cagliari ...)"))
r2=CLng(InputBox ("Ruota numero 2: 0=no"))
cpg=CLng(InputBox ("Capogioco: 0=automatico"))
estr1=EstrazioneFin -(ncicli*(cicli+1))
For cc =1 To cicli
estr1=estr1+ncicli
estr2=estr1+ncicli
Erase pres
For es=estr1 To estr2
For e1=1 To 5
If pres(Estratto (es,r1,e1))=0 Then
numeri(Estratto (es,r1,e1))=numeri(Estratto(es,r1,e1))+1
pres(Estratto (es,r1,e1))=1
If numeri(Estratto (es,r1,e1))>nmax Then nmax=numeri(Estratto (es,r1,e1))
End If
If r2>0 Then
If pres(Estratto (es,r2,e1))=0 Then
numeri(Estratto (es,r2,e1))=numeri(Estratto(es,r2,e1))+1
pres(Estratto (es,r2,e1))=1
If numeri(Estratto (es,r2,e1))>nmax Then nmax=numeri(Estratto (es,r2,e1))
End If
End If
Next
Next
Next
stringa= "Ruote gioco: "+NomeRuota (r1)
If r2>0 Then stringa=stringa+" - "+NomeRuota(r2)
Scrivi stringa,True
ff=nmax+1
conta=0
Do
ff=ff-1
If ff=0 Then Exit Do
For cc=1 To 90
If numeri(cc)=ff Then
nsp=cc
Exit Do
End If
Next
Loop
If cpg>0 Then nsp= cpg
Scrivi "Ambata/Capogioco: "+CStr(nsp)
Erase numeri
estr1=EstrazioneFin -(ncicli*(cicli+1))
For cc =1 To cicli
estr1=estr1+ncicli
estr2=estr1+ncicli
For es=estr1 To estr2
For e1=1 To 5
If Estratto (es,r1,e1)=nsp Then
For e2= 1 To 5
If Estratto(es,r1,e2)<>nsp Then
numeri(Estratto (es,r1,e2))=numeri(Estratto(es,r1,e2))+1
If numeri(Estratto (es,r1,e2))>nmax Then nmax=numeri(Estratto (es,r1,e2))
End If
Next
End If
If r2>0 Then
If Estratto (es,r2,e1)=nsp Then
For e2=1 To 5
If Estratto(es,r2,e2)<>nsp Then
numeri(Estratto (es,r2,e2))=numeri(Estratto(es,r2,e2))+1
If numeri(Estratto (es,r2,e2))>nmax Then nmax=numeri(Estratto (es,r2,e2))
End If
Next
End If
End If
Next
Next
Next
ff=nmax+1
conta=0
Do
ff=ff-1
If ff=0 Then Exit Do
For cc=1 To 90
If numeri(cc)=ff Then
conta=conta+1
ns(conta)=cc
If conta>4 Then Exit Do
End If
Next
Loop
Scrivi "Abbinamenti x ambo: "+CStr(ns(1))+" - "+CStr(ns(2))+" - "+CStr(ns(3))+" - "+CStr(ns(4))
Scrivi "Cinquina x ambo e terno: "+CStr(nsp)+" - "+CStr(ns(1))+" - "+CStr(ns(2))+" - "+CStr(ns(3))+" - "+CStr(ns(4))

End Sub