Script per le sei chiavi di don nicola il polacco x spaziometria

adeleadele · 16 Marzo 2021

Lo studio è stato fatto da occhi di giada dove al seguente links riporta la tecnica dettagliata!http://occhidigiada58.blogspot.com/2013/01/le-sei-chiavi-magiche-di-don-nicola-il.html
Essendo imbranata in programmi chiedo se qualcuno è in grado di fare lo script! Vi ringrazio anticipatamente per la cortesia!

adeleadele · 16 Marzo 2021

ESEMPIO:

salvo50 · 22 Marzo 2021

Ciao a Tutti.

MarcoElle, Rudivall, Tiberio1, xeroxs.
Grazie

Ciao AdeleAdele, non è un solo metodo, ma sono 3 metodi distinti, per adesso ne ho fatto uno solo, quello nella seconda immagine, quando avrò del tempo libero e la voglia farò gli altri.

Lo script alla prima domanda chiede l'estrazione di partenza, se si vuole controllare l'esempio dell'estrazione del metodo si deve immettere il numero 8411 che è l'estrazione del 02-08-2011.

Alla seconda domanda si può impostare una ruota qualsiasi immettendo il numero della ruota (da 1 a 10) per la Nazionale il numero 12, e per tutte le ruote contemporaneamente il numero 11

Ecco lo script per Spaziometria, salvo errori o dimenticanze

Codice:

Option Explicit
Sub Main
   Dim Fin,Clp,Ini,Es,R1,Caso,Casi
   Dim Ruo,Som,Salvo50,FinR,IniR
   Dim X,Y,P,S,k,G,Z,K2,Am,Pt
   Dim Ba(5),Ba2(5),A(5),P1(5),P2(5)
   Dim P3(5),P4(5),P5(5),P6(5),A1(4)
   Dim Det1(1),Det2(1),Det3(1),Det4(1),Det5(1)
   Dim Ru(1),Post1(1),Post2(2),Post6(6),Post7(7)
   Dim Post8(8),Post9(9),Post10(10)
   Dim Amba(1),Ambo(2)
   Post1(1) = 1
   Post2(2) = 1
   Post6(6) = 1
   Post7(7) = 1
   Post8(8) = 1
   Post9(9) = 1
   Post10(10) = 1
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10700)
   Ruo = InputBox("Vuoi fare la ricerca Per Ruota Singola Indica il Numero - da 1 a 10 Per Nazionale 12, Per Tutte le Ruote 11 ?",Salvo50,8)
   Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca?",Salvo50,10))
   Scrivi Space(15) & " LE SEI CHIAVI MAGICHE 2 - SCRIPT Salvo50" & Space(15),1,,4,,3,,1
   Call ScegliRange(Ini,Fin,Ini,Fin)
   If Ruo = 11 Then
      IniR = 1
      FinR = 12
   Else
      IniR = Ruo
      FinR = Ruo
   End If
   For Es = Ini To Fin
      Caso = 0
      AvanzamentoElab Ini,Fin,Es
      For R1 = IniR To FinR
         If R1 = 11 Then R1 = 12
         Som = SommaEstratti(Es,R1)
         For k = 1 To 5
            A(k) = Estratto(Es,R1,k)
            If k = 1 Then Ba(1) = 645 & Format2(A(1))
            If k = 2 Then Ba(2) = 554 & Format2(A(2))
            If k = 3 Then Ba(3) = 463 & Format2(A(3))
            If k = 4 Then Ba(4) = 372 & Format2(A(4))
            If k = 5 Then Ba(5) = 281 & Format2(A(5))
            P1(k) = Piramide(Ba(k),1)
            P2(k) = Piramide(Ba(k),2)
            P3(k) = Piramide(Ba(k),3)
            If k = 1 Then Ba2(1) = Som & P3(1)
            If k = 2 Then Ba2(2) = Som & P3(2)
            If k = 3 Then Ba2(3) = Som & P3(3)
            If k = 4 Then Ba2(4) = Som & P3(4)
            If k = 5 Then Ba2(5) = Som & P3(5)
            P4(k) = Piramide(Ba2(k),1)
            P5(k) = Piramide(Ba2(k),2)
            P6(k) = Piramide(Ba2(k),3)
         Next
         For K2 = 1 To 5
            P3(K2) = Fuori90(P3(K2))
            P6(K2) = Fuori90(P6(K2))
         Next
         Call ContaPunti(P3,P6,Pt)
         If Pt = 1 Then
            P = 0
            For X = 1 To 5
               For Y = 1 To 5
                  If P3(X) = P6(Y) Then S = Format2(P6(Y)) & " " & Y : P = Y
               Next
            Next
            If P = 1 Then Am = P6(1) : A1(1) = P6(2) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 2 Then Am = P6(2) : A1(1) = P6(1) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 3 Then Am = P6(3) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 4 Then Am = P6(4) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(5)
            If P = 5 Then Am = P6(5) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(4)
            '
            Amba(1) = Am
            Det1(1) = P6(1) : Det2(1) = P6(2) : Det3(1) = P6(3) : Det4(1) = P6(4) : Det5(1) = P6(5)
            Caso = Caso + 1
            Casi = Casi + 1
            ColoreTesto 1
            Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
            ColoreTesto 2
            Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
            ColoreTesto 0
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1) & "  Sommaestratti = ",1,0
            Scrivi Format2(Som),1,0,,2
            Scrivi " Sesta Chiave",1,,,1
            Scrivi
            Scrivi Space(16) & " Le 5 Chiavi Con i 5 Estratti",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba(1),"00000") & Space(3) & FormattaStringa(Ba(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(3),"00000") & Space(3) & FormattaStringa(Ba(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P1(1),"0000") & Space(4) & FormattaStringa(P1(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000") & Space(4) & FormattaStringa(P1(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P2(1),"000") & Space(5) & FormattaStringa(P2(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(3),"000") & Space(5) & FormattaStringa(P2(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P3(1),"00") & Space(6) & FormattaStringa(P3(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(3),"00") & Space(6) & FormattaStringa(P3(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(5),"00") & "  <-- Cuspidi",1,,,1
            Scrivi
            Scrivi Space(15) & " La Sesta Chiave Con i 5 Cuspidi ",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba2(1),"00000") & Space(3) & FormattaStringa(Ba2(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(3),"00000") & Space(3) & FormattaStringa(Ba2(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P4(1),"0000") & Space(4) & FormattaStringa(P4(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000") & Space(4) & FormattaStringa(P4(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P5(1),"000") & Space(5) & FormattaStringa(P5(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(3),"000") & Space(5) & FormattaStringa(P5(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P6(1),"00") & Space(6) & FormattaStringa(P6(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(3),"00") & Space(6) & FormattaStringa(P6(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(5),"00"),1,,,1
            Scrivi
            Scrivi Space(13) & Format2(Am) & " Unico cuspide uguale in Posizione " & Format2(P),1,,,2
            Scrivi
            Scrivi Space(25) & " Pronostico ",1,,,1
            Scrivi Space(25) & Format2(Am) & " = Ambata ",1,,,2
            Scrivi Space(15) & StringaNumeri(A1," ",True) & " = Abbinamenti Per Ambo ",1,,,1
            Scrivi Space(12) & StringaNumeri(P6," ",True) & " = Estratti Determinati ",1,,,2
            Scrivi
            Ru(1) = R1
            Scrivi
            G = 1
            ImpostaGiocata G,Amba,Ru,Post1,Clp
            For Z = 1 To UBound(A1)
               If Amba(1) <> A1(Z)Then
                  Ambo(1) = Amba(1): Ambo(2) = A1(Z)
                  If Ambo(2) > 0 Then
                     G = G + 1
                     ImpostaGiocata G,Ambo,Ru,Post2,Clp
                  End If
               End If
            Next
            G = G + 1
            ImpostaGiocata G,Det1,Ru,Post6,Clp : G = G + 1
            ImpostaGiocata G,Det2,Ru,Post7,Clp : G = G + 1
            ImpostaGiocata G,Det3,Ru,Post8,Clp : G = G + 1
            ImpostaGiocata G,Det4,Ru,Post9,Clp : G = G + 1
            ImpostaGiocata G,Det5,Ru,Post10,Clp
            Gioca Es,,,1
         End If
      Next
   Next
   ScriviResoconto
End Sub
Function ContaPunti(P3,P6,Pt) 'Sostituisce PuntiSuArray Script By Joe
     Dim X,Y
     For X = 1 To UBound(P3)
          For Y = 1 To UBound(P6)
               If P3(X) = P6(Y) Then Pt = Pt + 1
          Next
     Next
     ContaPunti = Pt
End Function

adeleadele · 22 Marzo 2021

grazie salvo Bubu' proprio di te mi ha parlato! Salvo quella richiesta con cui ho fatto ambo secco a colpo può essere estrapolata in modo più facile chiedere tutti i numeri presenti oltre la linea 30 in tutte le ruote e quante volte poi si aggiungono all'ambata calcola ta su ruota e su tutte! Esempio per me c'è un 59 tra pal naz e tutte io ho calcolato con 2 -20 i primi se non ricordo male erano questi! Grazie

adeleadele · 22 Marzo 2021

Salvo mi da errore

salvo50 · 22 Marzo 2021

adeleadele ha scritto:
Salvo mi da errore Vedi l'allegato 2212131

A me non da errore, prova a caricarlo di nuovo.

adeleadele · 26 Marzo 2021

Salvo ho compreso come funziona esempio le cuspidi sono ambate e dovete considerare la gemella ! giorno 23 /3 dava cuspidi 17, 49 , 54, 21 59 da formare per ambo 63 5 13 79 essendo che nella ruota gemella era uscito il 17 ho considerato come ambata il 2 , di solito esce la 1 su ruota o gemella ebbene usci' 2 colpo 49 e 63 a roma!Ora viene cuspide 34 ottima nella gemella firenze (uscita spia 39 ,,e 4 e 64 manca 34)
34 Fir cag ) pos 1-4-5-,con 29.5.72 15 51 76!

adeleadele · 26 Marzo 2021

Guardate 23 febbraio dava cuspide la prima 17 Roma o Firenze !ambata 17 con 15 o 29 etc naturalmente ambetto a colpo 17 ed ambetto

adeleadele · 26 Marzo 2021

Guardate sempre Roma 1 cuspide 29 ambata da giocare per ambo ed ambetto con le altre cuspidi ed abbinamenti! 16/3 colpo nella gemella 29 e 45

adeleadele · 26 Marzo 2021

Roma fir prima cuspide 47 ha dato ambata 47 a Firenze terzo colpo su Roma il 20 /3/ ha dato ambetto!

bubù · Oggi alle 10:29

salvo50 ha scritto:

Ciao a Tutti.

MarcoElle, Rudivall, Tiberio1, xeroxs.
Grazie

Ciao AdeleAdele, non è un solo metodo, ma sono 3 metodi distinti, per adesso ne ho fatto uno solo, quello nella seconda immagine, quando avrò del tempo libero e la voglia farò gli altri.

Lo script alla prima domanda chiede l'estrazione di partenza, se si vuole controllare l'esempio dell'estrazione del metodo si deve immettere il numero 8411 che è l'estrazione del 02-08-2011.

Alla seconda domanda si può impostare una ruota qualsiasi immettendo il numero della ruota (da 1 a 10) per la Nazionale il numero 12, e per tutte le ruote contemporaneamente il numero 11

Ecco lo script per Spaziometria, salvo errori o dimenticanze

Codice:

Option Explicit
Sub Main
   Dim Fin,Clp,Ini,Es,R1,Caso,Casi
   Dim Ruo,Som,Salvo50,FinR,IniR
   Dim X,Y,P,S,k,G,Z,K2,Am
   Dim Ba(5),Ba2(5),A(5),P1(5),P2(5)
   Dim P3(5),P4(5),P5(5),P6(5),A1(4)
   Dim Det1(1),Det2(1),Det3(1),Det4(1),Det5(1)
   Dim Ru(1),Post1(1),Post2(2),Post6(6),Post7(7)
   Dim Post8(8),Post9(9),Post10(10)
   Dim Amba(1),Ambo(2)
   Post1(1) = 1
   Post2(2) = 1
   Post6(6) = 1
   Post7(7) = 1
   Post8(8) = 1
   Post9(9) = 1
   Post10(10) = 1
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9800)
   Ruo = InputBox("Vuoi fare la ricerca Per Ruota Singola Indica il Numero - da 1 a 10 Per Nazionale 12, Per Tutte le Ruote 11 ?",Salvo50,8)
   Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca?",Salvo50,10))
   Scrivi Space(15) & " LE SEI CHIAVI MAGICHE 2 - SCRIPT Salvo50" & Space(15),1,,4,,3,,1
   Call ScegliRange(Ini,Fin,Ini,Fin)
   If Ruo = 11 Then
      IniR = 1
      FinR = 12
   Else
      IniR = Ruo
      FinR = Ruo
   End If
   For Es = Ini To Fin
      Caso = 0
      AvanzamentoElab Ini,Fin,Es
      For R1 = IniR To FinR
         If R1 = 11 Then R1 = 12
         Som = SommaEstratti(Es,R1)
         For k = 1 To 5
            A(k) = Estratto(Es,R1,k)
            If k = 1 Then Ba(1) = 645 & Format2(A(1))
            If k = 2 Then Ba(2) = 554 & Format2(A(2))
            If k = 3 Then Ba(3) = 463 & Format2(A(3))
            If k = 4 Then Ba(4) = 372 & Format2(A(4))
            If k = 5 Then Ba(5) = 281 & Format2(A(5))
            P1(k) = Piramide(Ba(k),1)
            P2(k) = Piramide(Ba(k),2)
            P3(k) = Piramide(Ba(k),3)
            If k = 1 Then Ba2(1) = Som & P3(1)
            If k = 2 Then Ba2(2) = Som & P3(2)
            If k = 3 Then Ba2(3) = Som & P3(3)
            If k = 4 Then Ba2(4) = Som & P3(4)
            If k = 5 Then Ba2(5) = Som & P3(5)
            P4(k) = Piramide(Ba2(k),1)
            P5(k) = Piramide(Ba2(k),2)
            P6(k) = Piramide(Ba2(k),3)
         Next
         For K2 = 1 To 5
            P3(K2) = Fuori90(P3(K2))
            P6(K2) = Fuori90(P6(K2))
         Next
         If PuntiSuArray(P3,P6) = 1 Then
            P = 0
            For X = 1 To 5
               For Y = 1 To 5
                  If P3(X) = P6(Y) Then S = Format2(P6(Y)) & " " & Y : P = Y
               Next
            Next
            If P = 1 Then Am = P6(1) : A1(1) = P6(2) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 2 Then Am = P6(2) : A1(1) = P6(1) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 3 Then Am = P6(3) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 4 Then Am = P6(4) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(5)
            If P = 5 Then Am = P6(5) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(4)
            '
            Amba(1) = Am
            Det1(1) = P6(1) : Det2(1) = P6(2) : Det3(1) = P6(3) : Det4(1) = P6(4) : Det5(1) = P6(5)
            Caso = Caso + 1
            Casi = Casi + 1
            ColoreTesto 1
            Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
            ColoreTesto 2
            Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
            ColoreTesto 0
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1) & "  Sommaestratti = ",1,0
            Scrivi Format2(Som),1,0,,2
            Scrivi " Sesta Chiave",1,,,1
            Scrivi
            Scrivi Space(16) & " Le 5 Chiavi Con i 5 Estratti",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba(1),"00000") & Space(3) & FormattaStringa(Ba(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(3),"00000") & Space(3) & FormattaStringa(Ba(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P1(1),"0000") & Space(4) & FormattaStringa(P1(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000") & Space(4) & FormattaStringa(P1(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P2(1),"000") & Space(5) & FormattaStringa(P2(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(3),"000") & Space(5) & FormattaStringa(P2(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P3(1),"00") & Space(6) & FormattaStringa(P3(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(3),"00") & Space(6) & FormattaStringa(P3(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(5),"00") & "  <-- Cuspidi",1,,,1
            Scrivi
            Scrivi Space(15) & " La Sesta Chiave Con i 5 Cuspidi ",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba2(1),"00000") & Space(3) & FormattaStringa(Ba2(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(3),"00000") & Space(3) & FormattaStringa(Ba2(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P4(1),"0000") & Space(4) & FormattaStringa(P4(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000") & Space(4) & FormattaStringa(P4(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P5(1),"000") & Space(5) & FormattaStringa(P5(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(3),"000") & Space(5) & FormattaStringa(P5(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P6(1),"00") & Space(6) & FormattaStringa(P6(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(3),"00") & Space(6) & FormattaStringa(P6(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(5),"00"),1,,,1
            Scrivi
            Scrivi Space(13) & Format2(Am) & " Unico cuspide uguale in Posizione " & Format2(P),1,,,2
            Scrivi
            Scrivi Space(25) & " Pronostico ",1,,,1
            Scrivi Space(25) & Format2(Am) & " = Ambata ",1,,,2
            Scrivi Space(15) & StringaNumeri(A1," ",True) & " = Abbinamenti Per Ambo ",1,,,1
            Scrivi Space(12) & StringaNumeri(P6," ",True) & " = Estratti Determinati ",1,,,2
            Scrivi
            Ru(1) = R1
            Scrivi
            G = 1
            ImpostaGiocata G,Amba,Ru,Post1,Clp
            For Z = 1 To UBound(A1)
               If Amba(1) <> A1(Z)Then
                  Ambo(1) = Amba(1): Ambo(2) = A1(Z)
                  If Ambo(2) > 0 Then
                     G = G + 1
                     ImpostaGiocata G,Ambo,Ru,Post2,Clp
                  End If
               End If
            Next
            G = G + 1
            ImpostaGiocata G,Det1,Ru,Post6,Clp : G = G + 1
            ImpostaGiocata G,Det2,Ru,Post7,Clp : G = G + 1
            ImpostaGiocata G,Det3,Ru,Post8,Clp : G = G + 1
            ImpostaGiocata G,Det4,Ru,Post9,Clp : G = G + 1
            ImpostaGiocata G,Det5,Ru,Post10,Clp
            Gioca Es
         End If
      Next
   Next
   ScriviResoconto
End Sub

Buongiorno Salvo50, come si fa ad aggiungere la giocata per tutti e 5 gli estratti per Ambo e Terno??? se non ti è troppo disturbo puoi modificare questo script con l'aggiunta ? Grazie e Buona giornata

salvo50 · Oggi alle 11:27

Ciao a Tutti
Xeroxs, Rudivall
Grazie

Ho aggiunto la tua modifica, però lo script non rispetta la condizione che un cuspide delle
prime piramidi deve essere uguale a un cuspide delle seconde piramidi, questo confronto
l'avevo fatto con la funzione PuntiSuArray, che con le varie release non funziona allo stesso
modo, Joe aveva spiegato il motivo, non ricordo bene forse per la release 1.6.54 bisogna
aggiungere qualche parametro.

Codice:

Option Explicit
Sub Main
   Dim Fin,Clp,Ini,Es,R1,Caso,Casi
   Dim Ruo,Som,Salvo50,FinR,IniR
   Dim X,Y,P,S,k,G,Z,K2,Am,Pt
   Dim Ba(5),Ba2(5),A(5),P1(5),P2(5)
   Dim P3(5),P4(5),P5(5),P6(5),A1(4)
   Dim Det1(1),Det2(1),Det3(1),Det4(1),Det5(1)
   Dim Ru(1),Post1(1),Post2(2),Post6(6),Post7(7)
   Dim Post8(8),Post9(9),Post10(10),Poste(5)
   Dim Amba(1),Ambo(2)
   Poste(2) = 1
   Poste(3) = 1
   Post1(1) = 1
   Post2(2) = 1
   Post6(6) = 1
   Post7(7) = 1
   Post8(8) = 1
   Post9(9) = 1
   Post10(10) = 1
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10700)
   Ruo = InputBox("Vuoi fare la ricerca Per Ruota Singola Indica il Numero - da 1 a 10 Per Nazionale 12, Per Tutte le Ruote 11 ?",Salvo50,8)
   Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca?",Salvo50,10))
   Scrivi Space(15) & " LE SEI CHIAVI MAGICHE 2 - SCRIPT Salvo50" & Space(15),1,,4,,3,,1
 '  Call ScegliRange(Ini,Fin,Ini,Fin)
   If Ruo = 11 Then
      IniR = 1
      FinR = 12
   Else
      IniR = Ruo
      FinR = Ruo
   End If
   For Es = Ini To Fin
      Caso = 0
      AvanzamentoElab Ini,Fin,Es
      For R1 = IniR To FinR
         If R1 = 11 Then R1 = 12
         Som = SommaEstratti(Es,R1)
         For k = 1 To 5
            A(k) = Estratto(Es,R1,k)
            '    Next
            If k = 1 Then Ba(1) = 645 & Format2(A(1))
            If k = 2 Then Ba(2) = 554 & Format2(A(2))
            If k = 3 Then Ba(3) = 463 & Format2(A(3))
            If k = 4 Then Ba(4) = 372 & Format2(A(4))
            If k = 5 Then Ba(5) = 281 & Format2(A(5))
            P1(k) = Piramide(Ba(k),1)
            P2(k) = Piramide(Ba(k),2)
            P3(k) = Piramide(Ba(k),3)
            If k = 1 Then Ba2(1) = Som & P3(1)
            If k = 2 Then Ba2(2) = Som & P3(2)
            If k = 3 Then Ba2(3) = Som & P3(3)
            If k = 4 Then Ba2(4) = Som & P3(4)
            If k = 5 Then Ba2(5) = Som & P3(5)
            P4(k) = Piramide(Ba2(k),1)
            P5(k) = Piramide(Ba2(k),2)
            P6(k) = Piramide(Ba2(k),3)
         Next
         For K2 = 1 To 5
            P3(K2) = Fuori90(P3(K2))
            P6(K2) = Fuori90(P6(K2))
         Next
         Pt = 0
         Call ContaPunti(P3,P6,Pt)
         If Pt = 1 Then
            P = 0
            For X = 1 To 5
               For Y = 1 To 5
                  If P3(X) = P6(Y) Then S = Format2(P6(Y)) & " " & Y : P = Y
               Next
            Next
            Am = 0
            If P = 1 Then Am = P6(1) : A1(1) = P6(2) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 2 Then Am = P6(2) : A1(1) = P6(1) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 3 Then Am = P6(3) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 4 Then Am = P6(4) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(5)
            If P = 5 Then Am = P6(5) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(4)
            '
            Amba(1) = Am
            Det1(1) = P6(1) : Det2(1) = P6(2) : Det3(1) = P6(3) : Det4(1) = P6(4) : Det5(1) = P6(5)
            Caso = Caso + 1
            Casi = Casi + 1
            ColoreTesto 1
            Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
            ColoreTesto 2
            Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
            ColoreTesto 0
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1) & "  Sommaestratti = ",1,0
            Scrivi Format2(Som),1,0,,2
            Scrivi " Sesta Chiave",1,,,1
            Scrivi
            Scrivi Space(16) & " Le 5 Chiavi Con i 5 Estratti",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba(1),"00000") & Space(3) & FormattaStringa(Ba(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(3),"00000") & Space(3) & FormattaStringa(Ba(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P1(1),"0000") & Space(4) & FormattaStringa(P1(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000") & Space(4) & FormattaStringa(P1(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P2(1),"000") & Space(5) & FormattaStringa(P2(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(3),"000") & Space(5) & FormattaStringa(P2(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P3(1),"00") & Space(6) & FormattaStringa(P3(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(3),"00") & Space(6) & FormattaStringa(P3(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(5),"00") & "  <-- Cuspidi",1,,,1
            Scrivi
            Scrivi Space(15) & " La Sesta Chiave Con i 5 Cuspidi ",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba2(1),"00000") & Space(3) & FormattaStringa(Ba2(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(3),"00000") & Space(3) & FormattaStringa(Ba2(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P4(1),"0000") & Space(4) & FormattaStringa(P4(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000") & Space(4) & FormattaStringa(P4(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P5(1),"000") & Space(5) & FormattaStringa(P5(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(3),"000") & Space(5) & FormattaStringa(P5(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P6(1),"00") & Space(6) & FormattaStringa(P6(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(3),"00") & Space(6) & FormattaStringa(P6(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(5),"00"),1,,,1
            Scrivi
            Scrivi Space(13) & Format2(Am) & " Unico cuspide uguale in Posizione " & Format2(P),1,,,2
            Scrivi
            Scrivi Space(25) & " Pronostico ",1,,,1
            Scrivi Space(25) & Format2(Amba(1)) & " = Ambata ",1,,,2
            Scrivi Space(15) & StringaNumeri(A1," ",True) & " = Abbinamenti Per Ambo ",1,,,1
            Scrivi Space(12) & StringaNumeri(P6," ",True) & " = Estratti Determinati ",1,,,2
            Scrivi
            Ru(1) = R1
            Scrivi
            G = 1
            Z = 0
            ImpostaGiocata G,Amba,Ru,Post1,Clp
            For Z = 1 To 4 'To UBound(A1)
               If Amba(1) <> A1(Z)Then
                  Ambo(1) = Amba(1): Ambo(2) = A1(Z)
                  If Ambo(2) > 0 Then
                     G = G + 1
                     ImpostaGiocata G,Ambo,Ru,Post2,Clp
                  End If
               End If
            Next
            G = G + 1
            ImpostaGiocata G,Det1,Ru,Post6,Clp : G = G + 1
            ImpostaGiocata G,Det2,Ru,Post7,Clp : G = G + 1
            ImpostaGiocata G,Det3,Ru,Post8,Clp : G = G + 1
            ImpostaGiocata G,Det4,Ru,Post9,Clp : G = G + 1
            ImpostaGiocata G,Det5,Ru,Post10,Clp : G = G + 1
            ImpostaGiocata G,P6,Ru,Poste,Clp
            Gioca Es,,,1
         End If
      Next
   Next
   ScriviResoconto
End Sub
Function ContaPunti(P3,P6,Pt) 'Sostituisce PuntiSuArray Script By Joe
   Dim X,Y
   For X = 1 To UBound(P3)
      For Y = 1 To UBound(P6)
         If P3(X) = P6(Y) Then Pt = Pt + 1
      Next
   Next
   ContaPunti = Pt
End Function

bubù · Oggi alle 11:55

salvo50 ha scritto:

Ciao a Tutti
Xeroxs, Rudivall
Grazie

Ho aggiunto la tua modifica, però lo script non rispetta la condizione che un cuspide delle
prime piramidi deve essere uguale a un cuspide delle seconde piramidi, questo confronto
l'avevo fatto con la funzione PuntiSuArray, che con le varie release non funziona allo stesso
modo, Joe aveva spiegato il motivo, non ricordo bene forse per la release 1.6.54 bisogna
aggiungere qualche parametro.

Codice:

Option Explicit
Sub Main
   Dim Fin,Clp,Ini,Es,R1,Caso,Casi
   Dim Ruo,Som,Salvo50,FinR,IniR
   Dim X,Y,P,S,k,G,Z,K2,Am
   Dim Ba(5),Ba2(5),A(5),P1(5),P2(5)
   Dim P3(5),P4(5),P5(5),P6(5),A1(4)
   Dim Det1(1),Det2(1),Det3(1),Det4(1),Det5(1)
   Dim Ru(1),Post1(1),Post2(2),Post6(6),Post7(7)
   Dim Post8(8),Post9(9),Post10(10),Poste(5)
   Dim Amba(1),Ambo(2)
   Poste(2) = 1
   Poste(3) = 1
   Post1(1) = 1
   Post2(2) = 1
   Post6(6) = 1
   Post7(7) = 1
   Post8(8) = 1
   Post9(9) = 1
   Post10(10) = 1
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10700)
   Ruo = InputBox("Vuoi fare la ricerca Per Ruota Singola Indica il Numero - da 1 a 10 Per Nazionale 12, Per Tutte le Ruote 11 ?",Salvo50,8)
   Clp = CInt(InputBox("Per quanti colpi vuoi fare la ricerca?",Salvo50,10))
   Scrivi Space(15) & " LE SEI CHIAVI MAGICHE 2 - SCRIPT Salvo50" & Space(15),1,,4,,3,,1
   Call ScegliRange(Ini,Fin,Ini,Fin)
   If Ruo = 11 Then
      IniR = 1
      FinR = 12
   Else
      IniR = Ruo
      FinR = Ruo
   End If
   For Es = Ini To Fin
      Caso = 0
      AvanzamentoElab Ini,Fin,Es
      For R1 = IniR To FinR
         If R1 = 11 Then R1 = 12
         Som = SommaEstratti(Es,R1)
         For k = 1 To 5
            A(k) = Estratto(Es,R1,k)
            If k = 1 Then Ba(1) = 645 & Format2(A(1))
            If k = 2 Then Ba(2) = 554 & Format2(A(2))
            If k = 3 Then Ba(3) = 463 & Format2(A(3))
            If k = 4 Then Ba(4) = 372 & Format2(A(4))
            If k = 5 Then Ba(5) = 281 & Format2(A(5))
            P1(k) = Piramide(Ba(k),1)
            P2(k) = Piramide(Ba(k),2)
            P3(k) = Piramide(Ba(k),3)
            If k = 1 Then Ba2(1) = Som & P3(1)
            If k = 2 Then Ba2(2) = Som & P3(2)
            If k = 3 Then Ba2(3) = Som & P3(3)
            If k = 4 Then Ba2(4) = Som & P3(4)
            If k = 5 Then Ba2(5) = Som & P3(5)
            P4(k) = Piramide(Ba2(k),1)
            P5(k) = Piramide(Ba2(k),2)
            P6(k) = Piramide(Ba2(k),3)
         Next
         For K2 = 1 To 5
            P3(K2) = Fuori90(P3(K2))
            P6(K2) = Fuori90(P6(K2))
         Next
         If PuntiSuArray(P3,P6) = 1 Then
            P = 0
            For X = 1 To 5
               For Y = 1 To 5
                  If P3(X) = P6(Y) Then S = Format2(P6(Y)) & " " & Y : P = Y
               Next
            Next
            If P = 1 Then Am = P6(1) : A1(1) = P6(2) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 2 Then Am = P6(2) : A1(1) = P6(1) : A1(2) = P6(3) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 3 Then Am = P6(3) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(4) : A1(4) = P6(5)
            If P = 4 Then Am = P6(4) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(5)
            If P = 5 Then Am = P6(5) : A1(1) = P6(1) : A1(2) = P6(2) : A1(3) = P6(3) : A1(4) = P6(4)
            '
            Amba(1) = Am
            Det1(1) = P6(1) : Det2(1) = P6(2) : Det3(1) = P6(3) : Det4(1) = P6(4) : Det5(1) = P6(5)
            Caso = Caso + 1
            Casi = Casi + 1
            ColoreTesto 1
            Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
            ColoreTesto 2
            Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
            ColoreTesto 0
            Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
            Scrivi "  " & SiglaRuota(R1) & " " & StringaEstratti(Es,R1) & "  Sommaestratti = ",1,0
            Scrivi Format2(Som),1,0,,2
            Scrivi " Sesta Chiave",1,,,1
            Scrivi
            Scrivi Space(16) & " Le 5 Chiavi Con i 5 Estratti",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba(1),"00000") & Space(3) & FormattaStringa(Ba(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(3),"00000") & Space(3) & FormattaStringa(Ba(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P1(1),"0000") & Space(4) & FormattaStringa(P1(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000") & Space(4) & FormattaStringa(P1(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P1(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P2(1),"000") & Space(5) & FormattaStringa(P2(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(3),"000") & Space(5) & FormattaStringa(P2(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P2(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P3(1),"00") & Space(6) & FormattaStringa(P3(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(3),"00") & Space(6) & FormattaStringa(P3(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P3(5),"00") & "  <-- Cuspidi",1,,,1
            Scrivi
            Scrivi Space(15) & " La Sesta Chiave Con i 5 Cuspidi ",1,,,1
            Scrivi Space(13) & FormattaStringa(Ba2(1),"00000") & Space(3) & FormattaStringa(Ba2(2),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(3),"00000") & Space(3) & FormattaStringa(Ba2(4),"00000"),1,0,,2
            Scrivi Space(3) & FormattaStringa(Ba2(5),"00000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P4(1),"0000") & Space(4) & FormattaStringa(P4(2),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000") & Space(4) & FormattaStringa(P4(4),"0000"),1,0,,1
            Scrivi Space(4) & FormattaStringa(P4(3),"0000"),1,,,1
            Scrivi Space(13) & FormattaStringa(P5(1),"000") & Space(5) & FormattaStringa(P5(2),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(3),"000") & Space(5) & FormattaStringa(P5(4),"000"),1,0,,2
            Scrivi Space(5) & FormattaStringa(P5(5),"000"),1,,,2
            Scrivi Space(13) & FormattaStringa(P6(1),"00") & Space(6) & FormattaStringa(P6(2),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(3),"00") & Space(6) & FormattaStringa(P6(4),"00"),1,0,,1
            Scrivi Space(6) & FormattaStringa(P6(5),"00"),1,,,1
            Scrivi
            Scrivi Space(13) & Format2(Am) & " Unico cuspide uguale in Posizione " & Format2(P),1,,,2
            Scrivi
            Scrivi Space(25) & " Pronostico ",1,,,1
            Scrivi Space(25) & Format2(Amba(1)) & " = Ambata ",1,,,2
            Scrivi Space(15) & StringaNumeri(A1," ",True) & " = Abbinamenti Per Ambo ",1,,,1
            Scrivi Space(12) & StringaNumeri(P6," ",True) & " = Estratti Determinati ",1,,,2
            Scrivi
            Ru(1) = R1
            Scrivi
            G = 1
            ImpostaGiocata G,Amba,Ru,Post1,Clp
            For Z = 1 To UBound(A1)
               If Amba(1) <> A1(Z)Then
                  Ambo(1) = Amba(1): Ambo(2) = A1(Z)
                  If Ambo(2) > 0 Then
                     G = G + 1
                     ImpostaGiocata G,Ambo,Ru,Post2,Clp
                  End If
               End If
            Next
            G = G + 1
            ImpostaGiocata G,Det1,Ru,Post6,Clp : G = G + 1
            ImpostaGiocata G,Det2,Ru,Post7,Clp : G = G + 1
            ImpostaGiocata G,Det3,Ru,Post8,Clp : G = G + 1
            ImpostaGiocata G,Det4,Ru,Post9,Clp : G = G + 1
            ImpostaGiocata G,Det5,Ru,Post10,Clp : G = G + 1
            ImpostaGiocata G,P6,Ru,Poste,Clp
            Gioca Es
         End If
      Next
   Next
   ScriviResoconto
End Sub

Grazie

e Buon fine settimana

joe · Oggi alle 13:08

Buongiorno Adele, Salvo, Bubù & Co.

Si ricordo che quanto fatto da Luigi aveva modificato radicalmente la funzione.

Non ricordo invece come parametrare gli array affinché possa funzionare.

Di conseguenza ho preferito scrivere una piccola funzione da aggiungere in fondo allo script.

Perché questo, mi è più veloce e comodo che fare "100" prove, prima di ottenere il risultato voluto.

Codice:

Function ContaPunti(P3,P6) 'Sostituisce PuntiSuArray Script By Joe
     Dim X,Y,Pt
     For X = 1 To UBound(P3)
          For Y = 1 To UBound(P6)
               If P3(X) = P6(Y) Then Pt = Pt + 1
          Next
     Next
     ContaPunti = Pt
End Function

Va da sè, che nella Main dello script si dovrà sostituire PuntiSuArray con ContaPunti.

Altrimenti questa nuova funzione non sarà richiamata e lo script funzionerà come prima.

salvo50 · Oggi alle 13:09

Grazie Joe, speravo in un tuo intervento

salvo50 · Oggi alle 13:34

Lo script del Post 12 è da riprendere, modificato con l'aiuto di Joe
Però c'è ancora qualche errorino che sto cercando di correggere
Ho modificato anche lo script del Post 3

joe · Oggi alle 14:02

Ciao Salvo,

Se la funzione che ho scritto l'avessi chiamata PuntiSuArray, avrebbe funzionato ugualmente sostituendo completamente quella originale.

Pertanto ContaPunti, "ritorna" come variabile contenendo, in sé, il valore dei punti e non necessita della terza variabile (pt).

Se aggiunta, questa pt, crea scompiglio e fa da spola avanti e indietro (tra la Main e la Function) trasportando i valori in essa presenti.

Sia quelli che ha in entrata, sia quelli che trasporta al suo ritorno nella Main.

Cioè deve essere azzerata prima di ogni call della ContaPunti (come hai giustamente fatto)

salvo50 · Oggi alle 14:40

joe ha scritto:
Ciao Salvo,

Se la funzione che ho scritto l'avessi chiamata PuntiSuArray, avrebbe funzionato ugualmente sostituendo completamente quella originale.

Pertanto ContaPunti, ritorna contenendo in sé il valore dei punti e non necessita della terza variabile (pt).

Se aggiunta, questa, crea scompiglio e fa da spola avanti e indietro (tra Main e Function) trasferendo i valori in essa presenti.

Sia quelli che ha in entrata, sia quelli che trasporta al suo ritorno nella Main.

Avevo trovato l'errorino e stavo per postare lo script corretto, quando ho visto
questo tuo intervento, allora ho tolto PT e ho incasinato tutto, andava sempre in
errore, quindi ho rimesso PT e postato, lo script è da riprendere

Script per le sei chiavi di don nicola il polacco x spaziometria

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<