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ù · Ieri 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 · Ieri 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ù · Ieri 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 · Ieri 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 · Ieri alle 13:09

Grazie Joe, speravo in un tuo intervento

salvo50 · Ieri 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 · Ieri 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 · Ieri 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

joe · Ieri alle 20:33

salvo50 ha scritto:
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

Ciao Salvo

non ho capito il perché dell'errore.

Questo script a me funziona senza problemi.

E' quello che avevo preso prima delle correzioni.

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 ContaPunti(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
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

salvo50 · Oggi alle 00:10

L' errorino non era nella tua modifica ma da un'altra parte che adesso non ricordo, se mi viene in mente te lo dico
comunque non può essere che hai preso l'originale quello che c'era prima che io facessi la modifica, perchè, per
esempio in questa riga
Scrivi Space(25) & Format2(Amba(1)) & " = Ambata ",1,,,2

prima che io facessi la modifica era così

Scrivi Space(25) & Format2(Am) & " = Ambata ",1,,,2

non cambia niente le righe sono tutte e due valide , ma io non essendo un esperto
a volte quando devo corregere qualche errore che non riesco a trovare
mi arrampico sugli specchi.

Lo script che c'era prima di fare la tua modifica l'ho cancellato e quindi
non so più che cavolo ho fatto.

Comunque senza il tuo intervento non avrei risolto

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<

Advanced Member >PLATINUM PLUS<

Advanced Member >PLATINUM PLUS<