Chi riesce a fare lo script da un vecchio metodo?

DATA · Ieri alle 16:34

ciao rosella hai fatto girare il mio su spaziometria? controlla le ultime tre estrazioni e si deve trovare su due ruote, due coppie di numeri ( 2 ambi ) appartenenti alla stessa cinquina pentagonale, il quinto non ancora sortito sara' il capogioco della previsione

joe · Ieri alle 17:05

Rossella35 ha scritto:
grazie salvo50 , questo tuo metodo fa la ricerca nella stessa estrazione, in realtà la ricerca si fa controllando le ultime tre estrazioni e si deve trovare su due ruote, due coppie di numeri ( 2 ambi ) appartenenti alla stessa cinquina pentagonale, il quinto non ancora sortito sara' il capogioco della nostra previsione., Da questo listato come si fà la modifica? ti ringrazio per quello che fai...

E' una descrizione piuttosto diversa da quella iniziale o da come l'avevo capita.

Essa richiede un altro script, perché modificare quello esistente è più complicato che riscriverlo

con queste regole.

salvo50 · Ieri alle 17:08

Rossella35 ha scritto:
Dalle previsioni del 30/06 PA/NA 87.84-87.39 ha dato terno a ruota all'ottavo colpo

Ciao Rossella35, ho fatto la previsione nei 3 colpi precedenti, ma il terno da te menzionato, non c'è
Quindi dovresti mettere oltre all'estrazione 30/06 anche l'anno e anche la cinquina pentagonale
di cui hai ricavato i numeri del terno, per poter capire dove sto sbagliando

Rossella35 · Ieri alle 17:45

salvo50 ha scritto:
Ciao Rossella35, ho fatto la previsione nei 3 colpi precedenti, ma il terno da te menzionato, non c'è
Quindi dovresti mettere oltre all'estrazione 30/06 anche l'anno e anche la cinquina pentagonale
di cui hai ricavato i numeri del terno, per poter capire dove sto sbagliando

mi spiego meglio se ci riesco: nell'estrazione del 30/5 a palermo sono usciti i numeri 15 e 33, nell'estrazione del 26/5 a napoli sono usciti i numeri 51e 69, la previsione era 87.84 e 87.39 uscita a palermo il 13/06/2026, la ricerca oltre alla ultima estrazione si fa anche nelle 3 estrazioni precedenti

Rossella35 · Ieri alle 17:54

un esempio, estrazione del 23/06/2026 escono fuori le seguenti previsioni:
CA/NZ 58.26 58.71
BA/FI 78.66 - 78.21
PA/VE 36.72 - 36.27
PA/NZ 36.72 - 36.27
io purtroppo non riuscendo a fare un listato per spaziometria, faccio tutto con carta e penna.

DATA · Ieri alle 18:16

DATA · Ieri alle 18:18

ora c e anche nz , e per calcolare 3 estrazioni indietro , si usa l ultima - 3
Option Explicit

Const RUOTE_DIVERSE = True
Const ESTRAZIONI_A_RITROSO = 4

Sub Main

Dim aRuote
Dim aTitoli
Dim aRiga

Dim Fine
Dim Inizio
Dim es
Dim iRuota
Dim Ruota
Dim p
Dim num
Dim idCin

Dim aCnt()
Dim aN1()
Dim aN2()

Dim h
Dim hCap
Dim h1
Dim h2
Dim idRiga

Dim capogioco
Dim doppio
Dim Diametrale

Dim aHData()
Dim aHRuota()
Dim aHCin()
Dim aHN1()
Dim aHN2()

Dim trovato

Call CaricaRuote(aRuote)

Fine = EstrazioneFin
Inizio = Fine - ESTRAZIONI_A_RITROSO

If Inizio < EstrazioneIni Then
Inizio = EstrazioneIni
End If

h = 0
hCap = 128

ReDim aHData(hCap)
ReDim aHRuota(hCap)
ReDim aHCin(hCap)
ReDim aHN1(hCap)
ReDim aHN2(hCap)

For es = Inizio To Fine

For iRuota = 1 To UBound(aRuote)

Ruota = aRuote(iRuota)

ReDim aCnt(18)
ReDim aN1(18)
ReDim aN2(18)

For p = 1 To 5

num = Estratto(es, Ruota, p)
idCin = IdCinquinaDaNumero(num)

aCnt(idCin) = aCnt(idCin) + 1

If aCnt(idCin) = 1 Then
aN1(idCin) = num
ElseIf aCnt(idCin) = 2 Then
aN2(idCin) = num
End If

Next

For idCin = 1 To 18

If aCnt(idCin) = 2 Then

Call AggiungiAmboEsatto( _
h, hCap, _
aHData, aHRuota, aHCin, aHN1, aHN2, _
es, Ruota, idCin, aN1(idCin), aN2(idCin) _
)

End If

Next

Next

Next

ReDim aTitoli(14)

aTitoli(1) = "Cinquina"
aTitoli(2) = "Data 1"
aTitoli(3) = "Ruota 1"
aTitoli(4) = "Coppia 1"
aTitoli(5) = "Data 2"
aTitoli(6) = "Ruota 2"
aTitoli(7) = "Coppia 2"
aTitoli(8) = "Capogioco"
aTitoli(9) = "Doppio"
aTitoli(10) = "Diametrale"
aTitoli(11) = "Ambo 1"
aTitoli(12) = "Ambo 2"
aTitoli(13) = "Terno"
aTitoli(14) = "Ruote"

Call InitTabella(aTitoli, vbCyan)

Scrivi "Metodo cinquine pentagonali - ultima estrazione + 3 a ritroso", 1
Scrivi "Range controllato: " & GetInfoEstrazione(Inizio) & " -> " & GetInfoEstrazione(Fine), 1
Scrivi

trovato = False
idRiga = 0

For h1 = 1 To h - 1

For h2 = h1 + 1 To h

If aHCin(h1) = aHCin(h2) Then

If RUOTE_DIVERSE = False Or aHRuota(h1) <> aHRuota(h2) Then

If QuattroDiversi(aHN1(h1), aHN2(h1), aHN1(h2), aHN2(h2)) Then

capogioco = NumeroMancante( _
aHCin(h1), _
aHN1(h1), aHN2(h1), _
aHN1(h2), aHN2(h2) _
)

If capogioco > 0 Then

doppio = Doppio90(capogioco)
Diametrale = Diametrale90(doppio)

idRiga = idRiga + 1
trovato = True

ReDim aRiga(14)

aRiga(1) = StringaCinquina(aHCin(h1))
aRiga(2) = GetInfoEstrazione(aHData(h1))
aRiga(3) = SiglaRuota(aHRuota(h1))
aRiga(4) = FormatNum(aHN1(h1)) & "-" & FormatNum(aHN2(h1))

aRiga(5) = GetInfoEstrazione(aHData(h2))
aRiga(6) = SiglaRuota(aHRuota(h2))
aRiga(7) = FormatNum(aHN1(h2)) & "-" & FormatNum(aHN2(h2))

aRiga(8) = FormatNum(capogioco)
aRiga(9) = FormatNum(doppio)
aRiga(10) = FormatNum(Diametrale)

aRiga(11) = FormatNum(capogioco) & "-" & FormatNum(doppio)
aRiga(12) = FormatNum(capogioco) & "-" & FormatNum(Diametrale)
aRiga(13) = FormatNum(capogioco) & "-" & FormatNum(doppio) & "-" & FormatNum(Diametrale)

aRiga(14) = SiglaRuota(aHRuota(h1)) & "-" & SiglaRuota(aHRuota(h2))

Call AddRigaTabella(aRiga, , "center")

End If

End If

End If

End If

Next

Next

If trovato Then
Call CreaTabella
Else
Scrivi "Nessun segnale trovato con i parametri attuali.", 1
End If

End Sub

Sub CaricaRuote(ByRef aRuote)

ReDim aRuote(11)

aRuote(1) = BA_
aRuote(2) = CA_
aRuote(3) = FI_
aRuote(4) = GE_
aRuote(5) = MI_
aRuote(6) = NA_
aRuote(7) = PA_
aRuote(8) = RO_
aRuote(9) = TO_
aRuote(10) = VE_

' Slot array 11.
' Non è la ruota Tutte.
' Qui dentro viene messa la Nazionale/RN.
aRuote(11) = NZ_

End Sub

Sub AggiungiAmboEsatto( _
ByRef h, ByRef hCap, _
ByRef aHData, ByRef aHRuota, ByRef aHCin, ByRef aHN1, ByRef aHN2, _
es, Ruota, idCin, n1, n2 _
)

Dim nMin
Dim nMax

Call OrdinaCoppia(n1, n2, nMin, nMax)

h = h + 1

If h > hCap Then

hCap = hCap + 128

ReDim Preserve aHData(hCap)
ReDim Preserve aHRuota(hCap)
ReDim Preserve aHCin(hCap)
ReDim Preserve aHN1(hCap)
ReDim Preserve aHN2(hCap)

End If

aHData(h) = es
aHRuota(h) = Ruota
aHCin(h) = idCin
aHN1(h) = nMin
aHN2(h) = nMax

End Sub

Function IdCinquinaDaNumero(num)

IdCinquinaDaNumero = ((num - 1) Mod 18) + 1

End Function

Function NumeroCinquina(idCin, pos)

NumeroCinquina = idCin + ((pos - 1) * 18)

End Function

Function StringaCinquina(idCin)

StringaCinquina = _
FormatNum(NumeroCinquina(idCin, 1)) & "-" & _
FormatNum(NumeroCinquina(idCin, 2)) & "-" & _
FormatNum(NumeroCinquina(idCin, 3)) & "-" & _
FormatNum(NumeroCinquina(idCin, 4)) & "-" & _
FormatNum(NumeroCinquina(idCin, 5))

End Function

Function NumeroMancante(idCin, n1, n2, n3, n4)

Dim pos
Dim Val

NumeroMancante = 0

For pos = 1 To 5

Val = NumeroCinquina(idCin, pos)

If Val <> n1 And Val <> n2 And Val <> n3 And Val <> n4 Then
NumeroMancante = Val
Exit Function
End If

Next

End Function

Function QuattroDiversi(a, b, c, d)

QuattroDiversi = False

If a = b Then Exit Function
If a = c Then Exit Function
If a = d Then Exit Function
If b = c Then Exit Function
If b = d Then Exit Function
If c = d Then Exit Function

QuattroDiversi = True

End Function

Sub OrdinaCoppia(n1, n2, ByRef nMin, ByRef nMax)

If n1 <= n2 Then
nMin = n1
nMax = n2
Else
nMin = n2
nMax = n1
End If

End Sub

Function Doppio90(Val)

Doppio90 = ((Val * 2 - 1) Mod 90) + 1

End Function

Function Diametrale90(Val)

If Val <= 45 Then
Diametrale90 = Val + 45
Else
Diametrale90 = Val - 45
End If

End Function

Function FormatNum(Val)

FormatNum = Format2(Val)

End Function

DATA · Ieri alle 18:27

DATA · Ieri alle 18:28

Const ESTRAZIONI_A_RITROSO = 3 basta cambiare questo numero

Rossella35 · Ieri alle 20:20

DATA ha scritto:
Const ESTRAZIONI_A_RITROSO = 3 basta cambiare questo numero

Grazie, ma c'è il modo di vedere quanti colpi si devono ancora giocare (di solito 12 colpi)e quando sono usciti? Calcolando le spese e se c'è guadagno?

InRicordo · Ieri alle 23:11

dopo 47566 macro che facevano di tutto, anche andare al bar a bere una birra, dopo minacce e contumelie inenarrabili, scontri di bit, byte e pesci in faccia, ho ottenuto qualcosa, nel caso non fosse corretta non me lo dite! Potrei commettere un AIcidio!

Dallo script differisce solo la previsione del 20 cm, che lo script considera e la macro no, perchè ha un imperativo occorro SEMPRE 3 estrazioni, e l'estrazione del 20/06/2023 dopo sè ne ha una sola, quindi viene esclusa, se è corretta bene, se è sbagliata bene. non la tocco più, neanche sotto tortura.

salvo50 · Oggi alle 08:19

Ciao a Tutti

Confesso che sono negato a leggere le tabelle
per inRicordo e Data, non riesco a capire nelle tabelle
o script da voi postate, in quale colonna sono gli esiti
positivi.
Grazie

InRicordo · Oggi alle 11:12

salvo50 ha scritto:
Ciao a Tutti

Confesso che sono negato a leggere le tabelle
per inRicordo e Data, non riesco a capire nelle tabelle
o script da voi postate, in quale colonna sono gli esiti
positivi.
Grazie

Ciao Salvo50, intanto complimenti per i tuoi Script,
Nel file fatto da me (una fatica enorme spiegare alla AI qualcosa che non avevo capito!), le ultime 2 colonne sono dedicate all'uscita, o meno, dell'ambata e dell'ambo:

I numeri indicano dopo quante estrazioni è uscita la previsione (entro 9 estrazioni), Non esce non ha bisogno di spiegazioni.
Non ha ancora controllato l'esattezza di quello che la macro tira fuori, salvo pochi casi (corretti).
Questo è l'output completo:

salvo50 · Oggi alle 11:31

Per inRicordo, Grazie

per Rossella35, avevo chiesto ulteriori spiegazioni perché tu nel Post 13 avevi messo la data del 30/ 6
cioè trenta barra sei ma siccome ancora al giorno 30 non è arrivato, ne ho dedotto che era di un anno
passato, comunque non è successo niente, con le tue ultime spiegazioni ho capito dove sbagliavo
nello script ho messo un altro InputBox, alla terza domanda ti chiede quante estrazioni indietro vuoi
fare la ricerca dell'altro ambo, io per default l'ho messo a 3, ma tu puoi cambiarlo a piacere

Ecco lo script salvo errori o dimenticanze

Codice:

Option Explicit
Sub Main()
   Dim Es,Ini,Fin,R1,R2,R3,P1,P2,P3,P4,P5,P6
   Dim A,B,C,D,K1,K2,Casi,Caso,E1,E2,Es2,Ind
   Dim Salvo50,Clp1,Abb1,Abb2,k
   Dim Num(5),Nu(5),Ambo1(2),Ambo2(2),Terno(3)
   Dim Ruo(2),Posta(2),Poste(3)
   Posta(2) = 1
   Poste(2) = 1
   Poste(3) = 1
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10750)
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'ambata?",,10)
   Ind = InputBox(" Quante estrazioni a ritroso vuoi cercare gli ambi? ",,3)
   Call ScegliRange(Ini,Fin,Ini,Fin)
   Scrivi Space(6) & " Per Rossella 35 - Metodo Sulle Cinquine Pentagonali - Script Salvo50" & Space(6),1,,4,,3,,1
   For Es = Ini To Fin
      AvanzamentoElab Ini,Fin,Es
      Caso = 0
      For R1 = 1 To 12
         If R1 = 11 Then R1 = 12
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               If Distanza(A,B) = 18 Or Distanza(A,B) = 36 Then
                  k = CInt(Es - Ind )
                  For Es2 = Es  To k Step - 1
                     For R2 = 1 To 12
                        If R2 = 11 Then R2 = 12
                        If R2 <> R1 Then
                           For P3 = 1 To 4
                              For P4 = P3 + 1 To 5
                                 C = Estratto(Es2,R2,P3)
                                 D = Estratto(Es2,R2,P4)
                                 If(A <> C And B <> C And A <> D And B <> D) Then
                                    If(Distanza(A,C) = 18 Or Distanza(A,C) = 36) And(Distanza(B,C) = 18 Or Distanza(B,C) = 36) _
                                       And(Distanza(A,D) = 18 Or Distanza(A,D) = 36) And(Distanza(B,D) = 18 Or Distanza(B,D) = 36)Then '<<<<<
                                       Num(1) = A
                                       Nu(1) = A
                                       For K1 = 2 To 5
                                          Num(K1) = Fuori90(Num(K1 - 1) + 18)
                                          Nu(K1) = Num(K1)
                                       Next
                                       For K2 = 1 To 5
                                          If Num(K2) = A Or Num(K2) = B Or Num(K2) = C Or Num(K2) = D Then Num(K2) = 0
                                       Next
                                       OrdinaMatrice Nu,1
                                       OrdinaMatrice Num,- 1
                                       Abb1 = Fuori90(Num(1) * 2)
                                       Abb2 = Diametrale(Abb1)
                                       Ambo1(1) = Num(1) : Ambo1(2) = Abb1
                                       Ambo2(1) = Num(1) : Ambo2(2) = Abb2
                                       Terno(1) = Num(1) : Terno(2) = Abb1 : Terno(3) = Abb2
                                       Caso = Caso + 1
                                       Casi = Casi + 1
                                       ColoreTesto 1
                                       Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                       ColoreTesto 2
                                       Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                       ColoreTesto 0
                                       Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                       Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                                       For P5 = 1 To 5
                                          E1 = Estratto(Es,R1,P5)
                                          If E1 = A Or E1 = B Then
                                             ColoreTesto 2
                                          Else
                                             ColoreTesto 0
                                          End If
                                          Scrivi Format2(E1) & " ",1,0
                                          ColoreTesto 0
                                       Next
                                       Scrivi
                                       Scrivi(" Estrazione n." & Format2(Es2) & " del " & DataEstrazione(Es2)),1,0
                                       Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                                       For P6 = 1 To 5
                                          E2 = Estratto(Es2,R2,P6)
                                          If E2 = C Or E2 = D Then
                                             ColoreTesto 2
                                          Else
                                             ColoreTesto 0
                                          End If
                                          Scrivi Format2(E2) & " ",1,0
                                          ColoreTesto 0
                                       Next
                                       Scrivi
                                       Scrivi
                                       Scrivi " Cinquina Pentagonale Completa ",1,0
                                       Scrivi StringaNumeri(Nu," ",True),1,0,,1
                                       Scrivi "  Il numero mancante è  ",1,0
                                       Scrivi Format2(Num(1)),1,,,2
                                       Scrivi
                                       Ruo(1) = R1 : Ruo(2) = R2
                                       ImpostaGiocata 1,Ambo1,Ruo,Posta,Clp1
                                       ImpostaGiocata 2,Ambo2,Ruo,Posta,Clp1
                                       ImpostaGiocata 3,Terno,Ruo,Poste,Clp1
                                       Gioca Es,1
                                    End If
                                 End If
                              Next
                           Next
                        End If
                     Next
                  Next
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub

InRicordo · Oggi alle 13:15

Rossella35 ha scritto:
mi spiego meglio se ci riesco: nell'estrazione del 30/5 a palermo sono usciti i numeri 15 e 33, nell'estrazione del 26/5 a napoli sono usciti i numeri 51e 69, la previsione era 87.84 e 87.39 uscita a palermo il 13/06/2026, la ricerca oltre alla ultima estrazione si fa anche nelle 3 estrazioni precedenti

A Napoli ci sono 51,69,87 con 15 e 33 la cinquina pentagonale è completa. Non può esserci una previsione. Sono diventato pazzo a cercare di capire perché la macro non evidenziava questo caso, ma la macro ha ragione

DATA · 30 minuti fa

Option Explicit

Const DEFAULT_INIZIO = 1000
Const DEFAULT_COLPI_GIOCO = 12
Const DEFAULT_RITROSO = 3

Const RUOTE_DIVERSE = True
Const EVITA_DUPLICATI = True
Const USA_TABELLA = True
Const USA_GIOCATE_NATIVE = True
Const USA_GRAFICI = True

Sub Main()

Dim Es, Ini, Fin, Es2, EsMin
Dim R1, R2
Dim P1, P2, P3, P4
Dim A, B, C, D
Dim Capogioco, Doppio, Diam
Dim Caso, Casi
Dim Clp1, Ind

Dim Num(5), Nu(5)

Dim Ambata(1)
Dim Ambo1(2), Ambo2(2), Terno(3)
Dim Ruo(2)
Dim PostaAmb(1), PostaAmbo(2), PostaTerno(3)

Dim aTitoli, aRiga
Dim Chiave, SaltaCaso

Dim aKey(), nKey, capKey

Dim aPairLab(), aPairCnt(), nPair, capPair
Dim aCapLab(), aCapCnt(), nCap, capCap
Dim aCinLab(), aCinCnt(), nCin, capCin
Dim aRuotaLab(), aRuotaCnt(), nRuota, capRuota

Dim ColpoAmb, ColpoA1, ColpoA2, ColpoT
Dim TotAmb, TotA1, TotA2, TotT
Dim SommaAmb, SommaA1, SommaA2, SommaT

PostaAmb(1) = 1
PostaAmbo(2) = 1
PostaTerno(2) = 1
PostaTerno(3) = 1

Fin = EstrazioneFin

Ini = InputNumero("Inserisci l'estrazione iniziale", "Metodo Salvo50 , con percentuali", DEFAULT_INIZIO)
Clp1 = InputNumero("Per quanti colpi vuoi verificare?", "Colpi di gioco", DEFAULT_COLPI_GIOCO)
Ind = InputNumero("Quante estrazioni a ritroso vuoi cercare gli ambi?", "Estrazioni a ritroso", DEFAULT_RITROSO)

If Clp1 < 1 Then Clp1 = DEFAULT_COLPI_GIOCO
If Ind < 0 Then Ind = DEFAULT_RITROSO

Call ScegliRange(Ini, Fin, Ini, Fin)

capKey = 256
ReDim aKey(capKey)
nKey = 0

capPair = 128
ReDim aPairLab(capPair)
ReDim aPairCnt(capPair)
nPair = 0

capCap = 128
ReDim aCapLab(capCap)
ReDim aCapCnt(capCap)
nCap = 0

capCin = 128
ReDim aCinLab(capCin)
ReDim aCinCnt(capCin)
nCin = 0

capRuota = 128
ReDim aRuotaLab(capRuota)
ReDim aRuotaCnt(capRuota)
nRuota = 0

If USA_TABELLA Then

ReDim aTitoli(19)

aTitoli(1) = "Caso"
aTitoli(2) = "Estrazione 1"
aTitoli(3) = "Ruota 1"
aTitoli(4) = "Ambo 1"
aTitoli(5) = "Estrazione 2"
aTitoli(6) = "Ruota 2"
aTitoli(7) = "Ambo 2"
aTitoli(8) = "Cinquina"
aTitoli(9) = "Capogioco"
aTitoli(10) = "Doppio"
aTitoli(11) = "Diametrale"
aTitoli(12) = "Ambata"
aTitoli(13) = "Ambo A"
aTitoli(14) = "Ambo B"
aTitoli(15) = "Terno"
aTitoli(16) = "Esito Ambata"
aTitoli(17) = "Esito Ambo A"
aTitoli(18) = "Esito Ambo B"
aTitoli(19) = "Esito Terno"

Call InitTabella(aTitoli, vbCyan)

End If

Scrivi "Metodo Salvo50 - Cinquine Pentagonali - Versione percentuali", 1
Scrivi "Logica originale mantenuta: distanza 18/36, ricerca a ritroso, ruote diverse.", 1
Scrivi "Range: " & InfoEstrazione(Ini) & " -> " & InfoEstrazione(Fin), 1
Scrivi "Colpi verifica: " & Clp1 & " | Ritroso: " & Ind, 1
Scrivi

Casi = 0

For Es = Ini To Fin

AvanzamentoElab Ini, Fin, Es
Caso = 0

For R1 = 1 To 12

If R1 <> 11 Then

For P1 = 1 To 4

For P2 = P1 + 1 To 5

A = Estratto(Es, R1, P1)
B = Estratto(Es, R1, P2)

If IsDistanzaPentagonale(A, B) Then

EsMin = Es - Ind

If EsMin < EstrazioneIni Then
EsMin = EstrazioneIni
End If

For Es2 = Es To EsMin Step -1

For R2 = 1 To 12

If R2 <> 11 Then

If RUOTE_DIVERSE = False Or R2 <> R1 Then

For P3 = 1 To 4

For P4 = P3 + 1 To 5

C = Estratto(Es2, R2, P3)
D = Estratto(Es2, R2, P4)

If QuattroDiversi(A, B, C, D) Then

If TuttiCollegatiPentagonali(A, B, C, D) Then

Call CostruisciCinquinaPentagonale(A, Num, Nu)

Capogioco = NumeroMancanteDaCinquina(Num, A, B, C, D)

If Capogioco > 0 Then

Doppio = Fuori90(Capogioco * 2)
Diam = Diametrale(Doppio)

Chiave = ChiaveCaso(Es, R1, A, B, Es2, R2, C, D)

SaltaCaso = False

If EVITA_DUPLICATI Then

If ChiavePresente(aKey, nKey, Chiave) Then
SaltaCaso = True
Else
Call AggiungiChiave(aKey, nKey, capKey, Chiave)
End If

End If

If SaltaCaso = False Then

Caso = Caso + 1
Casi = Casi + 1

Call VerificaProduzione(Es, Clp1, R1, R2, Capogioco, Doppio, Diam, ColpoAmb, ColpoA1, ColpoA2, ColpoT)

If ColpoAmb > 0 Then
TotAmb = TotAmb + 1
SommaAmb = SommaAmb + ColpoAmb
End If

If ColpoA1 > 0 Then
TotA1 = TotA1 + 1
SommaA1 = SommaA1 + ColpoA1
End If

If ColpoA2 > 0 Then
TotA2 = TotA2 + 1
SommaA2 = SommaA2 + ColpoA2
End If

If ColpoT > 0 Then
TotT = TotT + 1
SommaT = SommaT + ColpoT
End If

Call AggiungiConteggio(aPairLab, aPairCnt, nPair, capPair, SiglaRuota(R1) & "-" & SiglaRuota(R2))
Call AggiungiConteggio(aCapLab, aCapCnt, nCap, capCap, Format2(Capogioco))
Call AggiungiConteggio(aCinLab, aCinCnt, nCin, capCin, StringaCinquinaArray(Nu))
Call AggiungiConteggio(aRuotaLab, aRuotaCnt, nRuota, capRuota, SiglaRuota(R1))
Call AggiungiConteggio(aRuotaLab, aRuotaCnt, nRuota, capRuota, SiglaRuota(R2))

If USA_TABELLA Then

ReDim aRiga(19)

aRiga(1) = Format2(Casi)

aRiga(2) = InfoEstrazione(Es)
aRiga(3) = SiglaRuota(R1)
aRiga(4) = CoppiaOrdinata(A, B)

aRiga(5) = InfoEstrazione(Es2)
aRiga(6) = SiglaRuota(R2)
aRiga(7) = CoppiaOrdinata(C, D)

aRiga(8) = StringaCinquinaArray(Nu)
aRiga(9) = Format2(Capogioco)
aRiga(10) = Format2(Doppio)
aRiga(11) = Format2(Diam)

aRiga(12) = Format2(Capogioco)
aRiga(13) = Format2(Capogioco) & "-" & Format2(Doppio)
aRiga(14) = Format2(Capogioco) & "-" & Format2(Diam)
aRiga(15) = Format2(Capogioco) & "-" & Format2(Doppio) & "-" & Format2(Diam)

aRiga(16) = TestoEsito(ColpoAmb)
aRiga(17) = TestoEsito(ColpoA1)
aRiga(18) = TestoEsito(ColpoA2)
aRiga(19) = TestoEsito(ColpoT)

Call AddRigaTabella(aRiga, , "center")

End If

If USA_GIOCATE_NATIVE Then

Ambata(1) = Capogioco

Ambo1(1) = Capogioco
Ambo1(2) = Doppio

Ambo2(1) = Capogioco
Ambo2(2) = Diam

Terno(1) = Capogioco
Terno(2) = Doppio
Terno(3) = Diam

Ruo(1) = R1
Ruo(2) = R2

ImpostaGiocata 1, Ambata, Ruo, PostaAmb, Clp1
ImpostaGiocata 2, Ambo1, Ruo, PostaAmbo, Clp1
ImpostaGiocata 3, Ambo2, Ruo, PostaAmbo, Clp1
ImpostaGiocata 4, Terno, Ruo, PostaTerno, Clp1

Gioca Es, 1

End If

End If

End If

End If

End If

Next

Next

End If

End If

Next

Next

End If

Next

Next

End If

Next

If ScriptInterrotto Then Exit Sub

Next

If Casi > 0 Then

If USA_TABELLA Then
Call CreaTabella
End If

Scrivi
Scrivi "==================== RIEPILOGO OTTIMIZZATO ====================", 1
Scrivi "Casi validi trovati: " & Casi, 1
Scrivi
Scrivi "Ambata capogioco: " & TotAmb & " su " & Casi & " (" & Percentuale(TotAmb, Casi) & ") | Media colpo: " & MediaColpo(TotAmb, SommaAmb), 1
Scrivi "Ambo A capogioco+doppio: " & TotA1 & " su " & Casi & " (" & Percentuale(TotA1, Casi) & ") | Media colpo: " & MediaColpo(TotA1, SommaA1), 1
Scrivi "Ambo B capogioco+diametrale: " & TotA2 & " su " & Casi & " (" & Percentuale(TotA2, Casi) & ") | Media colpo: " & MediaColpo(TotA2, SommaA2), 1
Scrivi "Terno capogioco+doppio+diametrale: " & TotT & " su " & Casi & " (" & Percentuale(TotT, Casi) & ") | Media colpo: " & MediaColpo(TotT, SommaT), 1
Scrivi

If USA_GRAFICI Then

Call ScriviGraficoProduzione(Casi, TotAmb, TotA1, TotA2, TotT)
Call ScriviGraficoConteggi("Coppie di ruote piu presenti", aPairLab, aPairCnt, nPair, 15)
Call ScriviGraficoConteggi("Capogiochi piu presenti", aCapLab, aCapCnt, nCap, 15)
Call ScriviGraficoConteggi("Cinquine piu presenti", aCinLab, aCinCnt, nCin, 10)
Call ScriviGraficoConteggi("Ruote piu coinvolte", aRuotaLab, aRuotaCnt, nRuota, 12)

End If

If USA_GIOCATE_NATIVE Then
Scrivi
Scrivi "==================== RESOCONTO NATIVO ====================", 1
ScriviResoconto
End If

Else

Scrivi "Nessun segnale trovato con i parametri attuali.", 1

End If

End Sub

Function InputNumero(Testo, Titolo, DefaultVal)

Dim V

V = InputBox(Testo, Titolo, DefaultVal)

If Trim(CStr(V)) = "" Then
InputNumero = DefaultVal
Exit Function
End If

If IsNumeric(V) Then
InputNumero = CLng(V)
Else
InputNumero = DefaultVal
End If

End Function

Function InfoEstrazione(ByVal Es)

InfoEstrazione = Format2(Es) & " del " & DataEstrazione(Es)

End Function

Function IsDistanzaPentagonale(ByVal N1, ByVal N2)

IsDistanzaPentagonale = False

If Distanza(N1, N2) = 18 Then
IsDistanzaPentagonale = True
Exit Function
End If

If Distanza(N1, N2) = 36 Then
IsDistanzaPentagonale = True
Exit Function
End If

End Function

Function TuttiCollegatiPentagonali(ByVal A, ByVal B, ByVal C, ByVal D)

TuttiCollegatiPentagonali = False

If IsDistanzaPentagonale(A, C) = False Then Exit Function
If IsDistanzaPentagonale(B, C) = False Then Exit Function
If IsDistanzaPentagonale(A, D) = False Then Exit Function
If IsDistanzaPentagonale(B, D) = False Then Exit Function

TuttiCollegatiPentagonali = True

End Function

Sub CostruisciCinquinaPentagonale(ByVal NBase, ByRef Num, ByRef Nu)

Dim K

Num(1) = NBase
Nu(1) = NBase

For K = 2 To 5
Num(K) = Fuori90(Num(K - 1) + 18)
Nu(K) = Num(K)
Next

OrdinaMatrice Nu, 1

End Sub

Function NumeroMancanteDaCinquina(ByRef Num, ByVal A, ByVal B, ByVal C, ByVal D)

Dim K
Dim N

NumeroMancanteDaCinquina = 0

For K = 1 To 5

N = Num(K)

If N <> A And N <> B And N <> C And N <> D Then
NumeroMancanteDaCinquina = N
Exit Function
End If

Next

End Function

Function QuattroDiversi(ByVal A, ByVal B, ByVal C, ByVal D)

QuattroDiversi = False

If A = B Then Exit Function
If A = C Then Exit Function
If A = D Then Exit Function
If B = C Then Exit Function
If B = D Then Exit Function
If C = D Then Exit Function

QuattroDiversi = True

End Function

Function CoppiaOrdinata(ByVal N1, ByVal N2)

If N1 <= N2 Then
CoppiaOrdinata = Format2(N1) & "-" & Format2(N2)
Else
CoppiaOrdinata = Format2(N2) & "-" & Format2(N1)
End If

End Function

Function StringaCinquinaArray(ByRef Nu)

StringaCinquinaArray = _
Format2(Nu(1)) & "-" & _
Format2(Nu(2)) & "-" & _
Format2(Nu(3)) & "-" & _
Format2(Nu(4)) & "-" & _
Format2(Nu(5))

End Function

Function ChiaveCaso(ByVal Es1, ByVal R1, ByVal A, ByVal B, ByVal Es2, ByVal R2, ByVal C, ByVal D)

Dim Blocco1
Dim Blocco2

Blocco1 = CStr(Es1) & "|" & SiglaRuota(R1) & "|" & CoppiaOrdinata(A, B)
Blocco2 = CStr(Es2) & "|" & SiglaRuota(R2) & "|" & CoppiaOrdinata(C, D)

If Blocco1 <= Blocco2 Then
ChiaveCaso = Blocco1 & "||" & Blocco2
Else
ChiaveCaso = Blocco2 & "||" & Blocco1
End If

End Function

Function ChiavePresente(ByRef aKey, ByVal nKey, ByVal Chiave)

Dim I

ChiavePresente = False

For I = 1 To nKey
If aKey(I) = Chiave Then
ChiavePresente = True
Exit Function
End If
Next

End Function

Sub AggiungiChiave(ByRef aKey, ByRef nKey, ByRef capKey, ByVal Chiave)

nKey = nKey + 1

If nKey > capKey Then
capKey = capKey + 256
ReDim Preserve aKey(capKey)
End If

aKey(nKey) = Chiave

End Sub

Sub AggiungiConteggio(ByRef aLab, ByRef aCnt, ByRef N, ByRef Cap, ByVal Etichetta)

Dim I

For I = 1 To N
If aLab(I) = Etichetta Then
aCnt(I) = aCnt(I) + 1
Exit Sub
End If
Next

N = N + 1

If N > Cap Then
Cap = Cap + 128
ReDim Preserve aLab(Cap)
ReDim Preserve aCnt(Cap)
End If

aLab(N) = Etichetta
aCnt(N) = 1

End Sub

Sub VerificaProduzione(ByVal EsSegnale, ByVal Colpi, ByVal R1, ByVal R2, ByVal Capogioco, ByVal Doppio, ByVal Diam, ByRef ColpoAmb, ByRef ColpoA1, ByRef ColpoA2, ByRef ColpoT)

Dim C
Dim EsControllo

ColpoAmb = 0
ColpoA1 = 0
ColpoA2 = 0
ColpoT = 0

For C = 1 To Colpi

EsControllo = EsSegnale + C

If EsControllo > EstrazioneFin Then Exit For

If ColpoAmb = 0 Then
If EsceAmbataSuRuote(EsControllo, R1, R2, Capogioco) Then
ColpoAmb = C
End If
End If

If ColpoA1 = 0 Then
If EsceAmboSuRuote(EsControllo, R1, R2, Capogioco, Doppio) Then
ColpoA1 = C
End If
End If

If ColpoA2 = 0 Then
If EsceAmboSuRuote(EsControllo, R1, R2, Capogioco, Diam) Then
ColpoA2 = C
End If
End If

If ColpoT = 0 Then
If EsceTernoSuRuote(EsControllo, R1, R2, Capogioco, Doppio, Diam) Then
ColpoT = C
End If
End If

If ColpoAmb > 0 And ColpoA1 > 0 And ColpoA2 > 0 And ColpoT > 0 Then Exit For

Next

End Sub

Function EsceAmbataSuRuote(ByVal EsControllo, ByVal R1, ByVal R2, ByVal Numero)

EsceAmbataSuRuote = False

If PresenteRuota(EsControllo, R1, Numero) Then
EsceAmbataSuRuote = True
Exit Function
End If

If R2 <> R1 Then
If PresenteRuota(EsControllo, R2, Numero) Then
EsceAmbataSuRuote = True
Exit Function
End If
End If

End Function

Function EsceAmboSuRuote(ByVal EsControllo, ByVal R1, ByVal R2, ByVal N1, ByVal N2)

EsceAmboSuRuote = False

If PresenteRuota(EsControllo, R1, N1) And PresenteRuota(EsControllo, R1, N2) Then
EsceAmboSuRuote = True
Exit Function
End If

If R2 <> R1 Then
If PresenteRuota(EsControllo, R2, N1) And PresenteRuota(EsControllo, R2, N2) Then
EsceAmboSuRuote = True
Exit Function
End If
End If

End Function

Function EsceTernoSuRuote(ByVal EsControllo, ByVal R1, ByVal R2, ByVal N1, ByVal N2, ByVal N3)

EsceTernoSuRuote = False

If PresenteRuota(EsControllo, R1, N1) And PresenteRuota(EsControllo, R1, N2) And PresenteRuota(EsControllo, R1, N3) Then
EsceTernoSuRuote = True
Exit Function
End If

If R2 <> R1 Then
If PresenteRuota(EsControllo, R2, N1) And PresenteRuota(EsControllo, R2, N2) And PresenteRuota(EsControllo, R2, N3) Then
EsceTernoSuRuote = True
Exit Function
End If
End If

End Function

Function PresenteRuota(ByVal EsControllo, ByVal Ruota, ByVal Numero)

Dim P

PresenteRuota = False

For P = 1 To 5
If Estratto(EsControllo, Ruota, P) = Numero Then
PresenteRuota = True
Exit Function
End If
Next

End Function

Function TestoEsito(ByVal Colpo)

If Colpo > 0 Then
TestoEsito = "SI al colpo " & CStr(Colpo)
Else
TestoEsito = "NO nei colpi"
End If

End Function

Function Percentuale(ByVal Valore, ByVal Totale)

If Totale <= 0 Then
Percentuale = "0%"
Else
Percentuale = FormatNumber((Valore / Totale) * 100, 2) & "%"
End If

End Function

Function MediaColpo(ByVal TotaleSortite, ByVal SommaColpi)

If TotaleSortite <= 0 Then
MediaColpo = "-"
Else
MediaColpo = FormatNumber(SommaColpi / TotaleSortite, 2)
End If

End Function

Sub ScriviGraficoProduzione(ByVal Casi, ByVal TotAmb, ByVal TotA1, ByVal TotA2, ByVal TotT)

Scrivi
Scrivi "-------------------- Produzione esiti --------------------", 1
Call RigaGraficoProduzione("Ambata", TotAmb, Casi)
Call RigaGraficoProduzione("Ambo A", TotA1, Casi)
Call RigaGraficoProduzione("Ambo B", TotA2, Casi)
Call RigaGraficoProduzione("Terno", TotT, Casi)

End Sub

Sub RigaGraficoProduzione(ByVal Nome, ByVal Valore, ByVal Totale)

Dim BarLen

If Totale <= 0 Then
BarLen = 0
Else
BarLen = CInt((Valore / Totale) * 30)
End If

If Valore > 0 And BarLen < 1 Then BarLen = 1

Scrivi PadRight(Nome, 12) & " " & String(BarLen, "#") & " " & Valore & "/" & Totale & " - " & Percentuale(Valore, Totale), 1

End Sub

Sub ScriviGraficoConteggi(ByVal Titolo, ByRef aLab, ByRef aCnt, ByVal N, ByVal MaxRighe)

Dim I, J
Dim tmpLab, tmpCnt
Dim MaxVal
Dim Scala
Dim BarLen
Dim aL(), aC()

If N <= 0 Then Exit Sub

ReDim aL(N)
ReDim aC(N)

For I = 1 To N
aL(I) = aLab(I)
aC(I) = aCnt(I)
Next

For I = 1 To N - 1
For J = I + 1 To N

If aC(J) > aC(I) Then

tmpCnt = aC(I)
aC(I) = aC(J)
aC(J) = tmpCnt

tmpLab = aL(I)
aL(I) = aL(J)
aL(J) = tmpLab

End If

Next
Next

MaxVal = aC(1)

Scrivi
Scrivi "-------------------- " & Titolo & " --------------------", 1

For I = 1 To N

If I > MaxRighe Then Exit For

If MaxVal > 0 Then
Scala = aC(I) / MaxVal
Else
Scala = 0
End If

BarLen = CInt(Scala * 30)

If BarLen < 1 Then BarLen = 1

Scrivi PadRight(aL(I), 24) & " " & String(BarLen, "#") & " " & aC(I), 1

Next

End Sub

Function PadRight(ByVal Testo, ByVal Lunghezza)

Testo = CStr(Testo)

If Len(Testo) >= Lunghezza Then
PadRight = Left(Testo, Lunghezza)
Else
PadRight = Testo & Space(Lunghezza - Len(Testo))
End If

End Function

DATA · 29 minuti fa

DATA · 27 minuti fa

ho messo 12 colpi , ho aggiunto tavola visiva percentuali, questo riguarda l ultimo mese

DATA · 25 minuti fa

visializzazione della pevisione con terno

Estrazione generatrice del pronostico 07200 [ 87 - 30/05/2026]
G 0001 Numeri in gioco : 87 su NA PA per Estratto

V N. [87 ] [PA] [.. .. 87 .. ..] Colpo. 8 Estratto 07208 [ 95 - 13/06/2026]
Interrotta per raggiunta durata

G 0002 Numeri in gioco : 87.84 su NA PA per Ambo
V N. [87.84 ] [PA] [.. .. 87 84 ..] C. 8 Ambo 07208 [ 95 - 13/06/2026]
Interrotta per raggiunta durata

G 0003 Numeri in gioco : 87.39 su NA PA per Ambo
V N. [87.39 ] [PA] [.. 39 87 .. ..] C. 8 Ambo 07208 [ 95 - 13/06/2026]
Interrotta per raggiunta durata

G 0004 Numeri in gioco : 87.84.39 su NA PA per Ambo,Terno
V N. [87.84.39 ] [PA] [.. 39 87 84 ..] Ccolpo 8 Terno 07208 [ 95 - 13/06/2026]
Interrotta per raggiunta durata

DATA · 18 minuti fa

la parte con percentuali puo essere usata per altri listati

Chi riesce a fare lo script da un vecchio metodo?

Member

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Junior Member

Junior Member

Member

Member

Member

Member

Junior Member

Advanced Member >PLATINUM<

Allegati

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Member

Member

Member

Member

Member