modificare script joe da ambo a terno

[ppaaoolloo]

ciao
questo script di joe
esegue la ricerca delle formazioni da 2 fino a 7 numeri
in maggior ritardo su TUTTE per la sorte di ambo

si potrebbe modificare per terno??

ringrazio anticipatamente

ecco lo script:

Option Explicit
Sub Main
Dim RitMinimo
Dim NumeriCercati
Dim RitardoMinimo
Dim i,j,k,n,r,q,w,jj,qqq
Dim FineRuote
Dim Fine
Dim FineCiclo
Dim AmbiRitardoValido
Dim RitardoAttuale
Dim Ritardo


'Script realizzato da Denis COSTANTINI - 23/06/2007
'lo script esegue la ricerca delle formazioni da 2 fino a 7 numeri
'in maggior ritardo su TUTTE per la sorte di ambo
'tempo stimato (usando i valori indicati in RitMinimo) circa 30 secondi
Scrivi("TABELLONE DELLE PRINCIPALI COMBINAZIONI IN RITARDO PER AMBO SU TUTTE")
Call Scrivi("aggiornato all'estrazione n° " & EstrazioniArchivio & " del " & DataEstrazione(EstrazioniArchivio))
Call Scrivi("")
'valori di ritardo minimo per velocizzare (!) la ricerca
RitMinimo = Array(0,0,270,135,90,68,55,45)

'inizia ricerca combinazioni da 2 a 7 numeri in ritardo per ambo su TUTTE
For NumeriCercati = 2 To 7
ReDim MaxRuota(11) ' MaxRuota = VarArrayCreate([0,11],3)
ReDim MaxNumero(90) ' MAxNumero = VarArrayCreate([0,90],3)
ReDim RuotaCercata(11)' RuotaCercata = VarArrayCreate([0,11],3)
ReDim Minim(90,90)' = VarArrayCreate([0,90,0,90],3)
ReDim RitAmbo(90,90) ' RitAmbo = VarArrayCreate([0,90,0,90],3)
ReDim Numeri(90) ' Numeri = VarArrayCreate([0,90],3)
ReDim OrdCom(20) ' OrdCom = VarArrayCreate([0,20],12)
ReDim OrdRit(20) ' OrdRit = VarArrayCreate([0,20],3)
Scrivi("combinazioni di " & NumeriCercati & " numeri con ritardo minimo di " & RitMinimo(NumeriCercati) & " estrazioni")
Scrivi("")
RitardoMinimo = RitMinimo(NumeriCercati)
'ricerca dei numeri richiesti
For i = 1 To 10
MaxRuota(i) = i
Next
FineRuote = 1 'indica al programma di continuare la ricerca finchè FineRuote=0
r = 0
RuotaCercata(r) = 0
Do
r = r + 1
RuotaCercata(r) = RuotaCercata(r - 1) + 1
If RuotaCercata(r) > MaxRuota(r) Then
Do
r = r - 1
If r = 0 Then
FineRuote = 0
Exit Do
End If
RuotaCercata(r) = RuotaCercata(r) + 1
Loop Until RuotaCercata(r) <= MaxRuota(r)
End If
If r = 10 Then
'memorizza il ritardo minimo dei 4005 ambi sulle ruote individuate
For i = 1 To 89
For j =(i + 1) To 90
Minim(i,j) = EstrazioniArchivio
For k = 1 To 10
If AmboRitardoTurbo(RuotaCercata(k),i,j) < Minim(i,j) Then
Minim(i,j) = AmboRitardoTurbo(RuotaCercata(k),i,j)
End If
Next
Next
Next
For i = 1 To NumeriCercati
MaxNumero(i) = 90 + i - NumeriCercati
Next
n = 1
Numeri = 1
'inizia la ricerca dei numeri
Do
Fine = 1
n = n + 1
Numeri = Numeri(n - 1) + 1
Do
If Numeri > MaxNumero Then
Do
n = n - 1
If n = 0 Then
Fine = 0
Exit Do
End If
Numeri = Numeri + 1
Loop Until Numeri <= MaxNumero
End If
If n > 1 Then
FineCiclo = 1
'controllo ritardo degli ambi
AmbiRitardoValido = 0 : Ritardo = EstrazioniArchivio
For j = 1 To(n - 1)
RitardoAttuale = Minim(Numeri(j),Numeri)
If RitardoAttuale < RitardoMinimo Then
Exit For
Else
AmbiRitardoValido = AmbiRitardoValido + 1
End If
Next
If AmbiRitardoValido =(n - 1) Then
If n = NumeriCercati Then
'trovato una combinazione
qqq = " "
For q = 1 To n
If Numeri(q) > 9 Then
qqq = qqq & Numeri(q) & " "
Else
qqq = qqq & " " & Numeri(q) & " "
End If
Next
For q = 1 To(n - 1)
For w =(q + 1) To n
If Ritardo > Minim(Numeri(q),Numeri(w)) Then
Ritardo = Minim(Numeri(q),Numeri(w))
End If
Next
Next
'
jj = 0
For j = 10 To 1 Step - 1
If Ritardo > OrdRit(j) Then
jj = j
End If
Next
If jj > 0 Then
If jj = 20 Then
OrdRit(20) = Ritardo
OrdCom(20) = qqq
Else
For j = 20 To jj + 1 Step - 1
OrdRit(j) = OrdRit(j - 1)
OrdCom(j) = OrdCom(j - 1)
Next
OrdRit(jj) = Ritardo
OrdCom(jj) = qqq
End If
End If
'
' Scrivi("")
Numeri = Numeri + 1
Else
FineCiclo = 0
End If
Else
Numeri = Numeri + 1
FineCiclo = 1
End If
Else
FineCiclo = 0
End If
If Fine = 0 Then Exit Do End If
Loop Until FineCiclo = 0
Loop Until Fine = 0
End If
Loop Until FineRuote = 0
'
For j = 1 To 20
If OrdRit(j) > 0 Then
Call Scrivi("TUTTE " & OrdCom(j) & " ritardo : " & OrdRit(j))
End If
Next
'
Scrivi("-----------------------------------------------------------------------")
'PosizioneBarra(2,7,NumeriCercati)
Call AvanzamentoElab(2,7,NumeriCercati)
If ScriptInterrotto Then Exit For
Next


End Sub

 

[Joe91]

ciao
questo script di joe
esegue la ricerca delle formazioni da 2 fino a 7 numeri
in maggior ritardo su TUTTE per la sorte di ambo

si potrebbe modificare per terno??

Ciao Paolo.

Questo script di Joe si legge chiaramente che non è di Joe:

Ovvero è scritto chiaramente:

"Script realizzato da Denis COSTANTINI - 23/06/2007"

Esso, per quanto mi riguarda, è valido così come è

e per come ... con l'aiuto di Luigi lo si è reso compatibile

e ben funzionante con Spaziometria.

Dunque non intendo modificarlo.

Mi spiace.

 

[ppaaoolloo]

ciao joe
se non intendi modificarlo tu
credo che nessun altro lo vorrà fare,
vorrà dire che ci accontenteremo di usarlo
(sempre che qualcuno lo voglia usare)
per la sola sorte di ambo.
dispiace anche a me utilizzarlo solo così
dato che poi non è certo che possa realizzzare un terno,
e poi non è mica la fine del mondo,
ci sono cose molto ben più importanti nella vita.
grazie comunque

 

[claudio8]

Poichè per me gli script servono a rintracciare numeri da giocare, mi sono permesso di inserire una variante di range fine estrazione gestibile dalla barra di SPTM e un costrutto "verificaesito" per visionare l'utilità della ricerca.
Un saluto e per che lo userà, fateci sapere se restituisce output interessanti, grazie.

Option Explicit
Sub Main
    Dim RitMinimo
    Dim NumeriCercati
    Dim RitardoMinimo
    Dim i,j,k,n,r,q,w,jj,qqq
    Dim FineRuote
    Dim Fine
    Dim FineCiclo
    Dim AmbiRitardoValido
    Dim RitardoAttuale
    Dim Ritardo
    'Script realizzato da Denis COSTANTINI - 23/06/2007
    'lo script esegue la ricerca delle formazioni da 2 fino a 7 numeri in maggior ritardo su TUTTE per la sorte di ambo
    'tempo stimato (usando i valori indicati in RitMinimo) circa 30 secondi
    'modificato di "EstrazioniArchivio" - ("finearchivio" modificabile direttamente da spaziometria)
    Scrivi("TABELLONE DELLE PRINCIPALI COMBINAZIONI IN RITARDO PER AMBO SU TUTTE")
    Call Scrivi("aggiornato all'estrazione n° " & EstrazioneFin & " del " & DataEstrazione(EstrazioneFin))
    Call Scrivi("")
    'valori di ritardo minimo per velocizzare (!) la ricerca
    RitMinimo = Array(0,0,270,135,90,68,55,45)
    'inizia ricerca combinazioni da 2 a 7 numeri in ritardo per ambo su TUTTE
    For NumeriCercati = 2 To 7 '(ingiocabile su tutte)
        ReDim MaxRuota(11) ' MaxRuota = VarArrayCreate([0,11],3)
        ReDim MaxNumero(90) ' MAxNumero = VarArrayCreate([0,90],3)
        ReDim RuotaCercata(11)' RuotaCercata = VarArrayCreate([0,11],3)
        ReDim Minim(90,90)' = VarArrayCreate([0,90,0,90],3)
        ReDim RitAmbo(90,90) ' RitAmbo = VarArrayCreate([0,90,0,90],3)
        ReDim Numeri(90) ' Numeri = VarArrayCreate([0,90],3)
        ReDim OrdCom(20) ' OrdCom = VarArrayCreate([0,20],12)
        ReDim OrdRit(20) ' OrdRit = VarArrayCreate([0,20],3)
        Scrivi("combinazioni di " & NumeriCercati & " numeri con ritardo minimo di " & RitMinimo(NumeriCercati) & " estrazioni")
        Scrivi("")
        RitardoMinimo = RitMinimo(NumeriCercati)
        'ricerca dei numeri richiesti
        For i = 1 To 10
            MaxRuota(i) = i
        Next
        FineRuote = 1 'indica al programma di continuare la ricerca finchè FineRuote=0
        r = 0
        RuotaCercata(r) = 0
        Do
            r = r + 1
            RuotaCercata(r) = RuotaCercata(r - 1) + 1
            If RuotaCercata(r) > MaxRuota(r) Then
                Do
                    r = r - 1
                    If r = 0 Then
                        FineRuote = 0
                        Exit Do
                    End If
                    RuotaCercata(r) = RuotaCercata(r) + 1
                Loop Until RuotaCercata(r) <= MaxRuota(r)
            End If
            If r = 10 Then ' per ogni ruota, combina i numeri ad ambo memorizza il ritardo minimo dei 4005 ambi sulle ruote individuate
                For i = 1 To 89
                    For j =(i + 1) To 90
                        Minim(i,j) = EstrazioneFin
                        For k = 1 To 10
                            If AmboRitardoTurbo(RuotaCercata(k),i,j) < Minim(i,j) Then '''''StatFrzTurbo
                                Minim(i,j) = AmboRitardoTurbo(RuotaCercata(k),i,j)
                            End If
                        Next
                    Next
                Next
                For i = 1 To NumeriCercati
                    MaxNumero(i) = 90 + i - NumeriCercati
                Next
                n = 1
                Numeri(n) = 1
                'inizia la ricerca dei numeri
                Do
                    Fine = 1
                    n = n + 1
                    Numeri(n) = Numeri(n - 1) + 1
                    Do
                        If Numeri(n) > MaxNumero(n) Then
                            Do
                                n = n - 1
                                If n = 0 Then
                                    Fine = 0
                                    Exit Do
                                End If
                                Numeri(n) = Numeri(n) + 1
                            Loop Until Numeri(n) <= MaxNumero(n)
                        End If
                        If n > 1 Then
                            FineCiclo = 1
                            'controllo ritardo degli ambi
                            AmbiRitardoValido = 0
                            Ritardo = EstrazioneFin
                            For j = 1 To(n - 1)
                                RitardoAttuale = Minim(Numeri(j),Numeri(n))
                                If RitardoAttuale < RitardoMinimo Then
                                    Exit For
                                Else
                                    AmbiRitardoValido = AmbiRitardoValido + 1
                                End If
                            Next
                            If AmbiRitardoValido =(n - 1) Then
                                If n = NumeriCercati Then
                                    'trovato una combinazione
                                    qqq = " "
                                    For q = 1 To n
                                        If Numeri(q) > 9 Then
                                            qqq = qqq & Numeri(q) & " "
                                        Else
                                            qqq = qqq & " " & Numeri(q) & " "
                                        End If
                                    Next
                                    For q = 1 To(n - 1)
                                        For w =(q + 1) To n
                                            If Ritardo > Minim(Numeri(q),Numeri(w)) Then
                                                Ritardo = Minim(Numeri(q),Numeri(w))
                                            End If
                                        Next
                                    Next
                                    '
                                    jj = 0
                                    For j = 10 To 1 Step - 1
                                        If Ritardo > OrdRit(j) Then
                                            jj = j
                                        End If
                                    Next
                                    If jj > 0 Then
                                        If jj = 20 Then
                                            OrdRit(20) = Ritardo
                                            OrdCom(20) = qqq
                                        Else
                                            For j = 20 To jj + 1 Step - 1
                                                OrdRit(j) = OrdRit(j - 1)
                                                OrdCom(j) = OrdCom(j - 1)
                                            Next
                                            OrdRit(jj) = Ritardo
                                            OrdCom(jj) = qqq
                                        End If
                                    End If
                                    '
                                    ' Scrivi("")
                                    Numeri(n) = Numeri(n) + 1
                                Else
                                    FineCiclo = 0
                                End If
                            Else
                                Numeri(n) = Numeri(n) + 1
                                FineCiclo = 1
                            End If
                        Else
                            FineCiclo = 0
                        End If
                        If Fine = 0 Then Exit Do End If
                    Loop Until FineCiclo = 0
                Loop Until Fine = 0
            End If
        Loop Until FineRuote = 0
        ReDim arue(10)
        Dim anum,a
        Dim retcolpi,esito,retestratti,Stringa,id
        ReDim retRuote(10)
        For a = 1 To 10
            retRuote(a) = a
        Next
        For j = 1 To 20 'righe di testo relative al ritardo
            If OrdRit(j) > 0 Then
                Stringa = OrdCom(j)
                anum = Split(Stringa," ",- 1)

                arue(1) = 11
                If VerificaEsito(anum,arue,EstrazioneFin + 1,2,,,,retcolpi,retestratti,id,retRuote) Then
                
                    Scrivi "TUTTE " & OrdCom(j) & " rit.: " & FormatSpace(OrdRit(j),3,1) & " - estio al " & FormatSpace(retcolpi,3,1) & "° colpo su " & retestratti & " - ",1,,-1,2
                Else
                    Scrivi "TUTTE " & OrdCom(j) & " rit.: " & FormatSpace(OrdRit(j),3,1) & " - estio negativo"
                End If

            End If
        Next
        Scrivi("-----------------------------------------------------------------------")
        'PosizioneBarra(2,7,NumeriCercati)
        Call AvanzamentoElab(2,7,NumeriCercati)
        If ScriptInterrotto Then Exit For
    Next
End Sub

 

[claudio8]

scusa:
BEL SCRIP ROVINATO , MEGLIO cancellarlo inoltre non fa quello che chiede ppaaoolloo

se ti spieghi meglio, forse potrei essere daccordo con te....

 

[houdini]

Effettivamente ho sbagliato il giudizio, serve x verificare gli esiti, comunque grazie