Script su Metodi Cabalistici, Ciclometrici & C.

[EVERITA C]

Ciao Salvo hai fatto un lavoro superlativo.

Di ottima fattura. Eccezionale come tutti i tuoi lavori.

Dirti grazie e' poco.

 

[mastrogino]

Ciao a Tutti

Solo adesso mi sono accorto che avevi chiesto di inserire la somma con InputBox

In questo puoi inserire la somma pari o dispari da input box

Option Explicit
Sub Main
   Dim X,Y,Z,K,Y2,Z3,Som,Qsom
   Qsom = CInt (InputBox("Quale somma vuoi visualizzare? ",,10))
   Scrivi Space(1) & "   Chiesto da EVERITAC - Somme Terne - sommare il primo numero      ",1,,4,,3,,1
   Scrivi Space(1) & " con il doppio del secondo PIù il triplo del terzo - Script Salvo50 ",1,,4,,3,,1
   For X = 1 To 90
      Messaggio X
      For Y = 1 To 90
         For Z = 1 To 90
            If X <> Y And X <> Z And Y <> Z Then
               Y2 = 0 : Z3 = 0
               Y2 = Fuori90(Y * 2)
               Z3 = Fuori90(Z * 3)
               Som = Fuori90(X + Y2 + Z3)
               If Som = Qsom Then
                  K = K + 1
                  Scrivi FormattaStringa(K,"0000") & Space(4) & Format2(X) & " " & Format2(Y) & " " & Format2(Z),1,0
                  Scrivi Space(4) & Format2(X) & " + " & Format2(Y2) & " + " & Format2(Z3) & " = " & Format2(Som),1
               End If
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   Scrivi
   Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub

In questo puoi decidere anche la somma dei numeri che non sono stati moltiplicati

Option Explicit
Sub Main
   Dim X,Y,Z,K,Y2,Z3,Som,SecSom,SomXYZ,PrSom
   PrSom = CInt(InputBox("Quale somma vuoi visualizzare? ",,23))
   SecSom = CInt(InputBox("Quale somma vuoi visualizzare? ",,36))
   Scrivi Space(1) & "   Chiesto da EVERITAC - Somme Terne - sommare il primo numero      ",1,,4,,3,,1
   Scrivi Space(1) & " con il doppio del secondo PIù il triplo del terzo - Script Salvo50 ",1,,4,,3,,1
   Scrivi
   Scrivi " Come prima somma è stata inserita   " & PrSom,1
   Scrivi " Come seconda somma è stata inserita " & SecSom,1
   Scrivi
   Scrivi "Qnt    X    Y    Z  1a Som    X    YX2  ZX3  2a Som",1,,,2
   For X = 1 To 90
      Messaggio X
      For Y = 1 To 90
         For Z = 1 To 90
            If X <> Y And X <> Z And Y <> Z Then
               SomXYZ = Fuori90(X + Y + Z)
               If SomXYZ = PrSom Then
                  Y2 = 0 : Z3 = 0
                  Y2 = Fuori90(Y * 2)
                  Z3 = Fuori90(Z * 3)
                  Som = Fuori90(X + Y2 + Z3)
                  If Som = SecSom Then
                     K = K + 1
                     Scrivi FormattaStringa(K,"000") & Space(4) & Format2(X) & " + " & Format2(Y) & " + " & Format2(Z),1,0
                     Scrivi " = " & Format2(SomXYZ),1,0
                     Scrivi Space(6) & Format2(X) & " + " & Format2(Y2) & " + " & Format2(Z3) & " = " & Format2(Som),1
                  End If
               End If
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   Scrivi
   Scrivi " Tempo Trascorso " & TempoTrascorso
End Sub

Buongiorno a tutti voi nel ringraziare Salvo per il suo altruismo e collaborazione per i suoi servizi ,
vi inserisco una previsione ottenuta da questo listato usando i vertibili , sperando che sia positiva nel minor tempo possibile
e se andra' in vincita vi svelo il modo di come e stato usato .
VI RINOVO GLI AUGURI DI UNA SANTA E PACE PASQUA 2025 A TUTTI

CA TT
89.88.62.26.
89.88.61.28.
89.88.32.84.
89.88.05.56.
89.88.10.78.

 

[salvo50]

BUONA PASQUA

 

[Baciccia4251]

BUONA PASQUA

Altrettanto

 

[rudivall]

Buona Pasqua a tutti, Auguri...

 

[KEN]

Buona Pasqua a tutti

 

[mastrogino]

Buongiorno a tutti voi nel ringraziare Salvo per il suo altruismo e collaborazione per i suoi servizi ,
vi inserisco una previsione ottenuta da questo listato usando i vertibili , sperando che sia positiva nel minor tempo possibile
e se andra' in vincita vi svelo il modo di come e stato usato .
VI RINOVO GLI AUGURI DI UNA SANTA E PACE PASQUA 2025 A TUTTI

CA TT
89.88.62.26.
89.88.61.28......88.61.tt
89.88.32.84.
89.88.05.56.
89.88.10.78.

 

[filippo1963]

Ciao a Tutti
Matematico, Bubù
Grazie

Option Explicit
Sub Main
   Dim FIn,Ini,Es,Clp,Salvo50
   Dim R1,R2,Caso,Casi,A,B,C,D,E,F
   Dim P1,P2,P3,P4,P5,E2,E1,Somma
   Dim Ruo(2),Posta(1),Amba(1)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10600)
   Clp = InputBox("Per quanti colpi vuoi giocare le Ambate? ",Salvo50,9)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(1) & " 2 Ruote e 2 Estratti Isotopi Somma Estratti Adiacenti  - By Filippo1963 - Script Salvo50",1,,4,,3,,1
   Posta(1) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 5
         For P2 = 1 To 5
            A = Estratto(Es,R1,P2)
            R2 = RuotaDiametrale(R1)
            B = Estratto(Es,R2,P2)
            If A > 0 And B > 0 Then
               If A = B Or A = Diametrale(B) Then
                  P1 = FuoriX(P2 + 4,5)
                  P3 = FuoriX(P2 + 1,5)
                  C = Estratto(Es,R1,P1)
                  D = Estratto(Es,R1,P3)
                  E = Estratto(Es,R2,P1)
                  F = Estratto(Es,R2,P3)
                  Somma = Fuori90(C + D + E + F)
                  Amba(1) = Diametrale(Somma)
                  Caso = Caso + 1
                  Casi = Casi + 1
                  Scrivi String(96,"o") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                  Scrivi String(87,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                  For P4 = 1 To 5
                     E1 = Estratto(Es,R1,P4)
                     If E1 = A Then ColoreTesto 2
                     If E1 = C Or E1 = D Then ColoreTesto 1
                     If E1 <> A And E1 <> C And E1 <> D Then ColoreTesto 0
                     Scrivi Format2(E1) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi "  " & SiglaRuota(R2) & "  ",1,0
                  For P5 = 1 To 5
                     E2 = Estratto(Es,R2,P5)
                     If E2 = B Then ColoreTesto 2
                     If E2 = E Or E2 = F Then ColoreTesto 1
                     If E2 <> B And E2 <> E And E2 <> F Then ColoreTesto 0
                     Scrivi Format2(E2) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi
                  Scrivi
                  Scrivi Space(10) & Format2(C) & " + " & Format2(D) & " + " & Format2(E) & " + " & Format2(F) & " = ",1,0
                  Scrivi Format2(Somma) & " Diametrale di " & Format2(Somma) & " = " & Format2(Amba(1)),1
                  Scrivi
                  Ruo(1) = R1 : Ruo(2) = R2
                  ImpostaGiocata 1,Amba,Ruo,Posta,Clp
                  Gioca Es,1
               End If
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub

Buona Pasqua a Tutti gli Utenti di questo fantastico Forum, chiedo venia sarebbe possibile modificare lo script per evidenziare solo gli estratti uguali isotopi in due ruote delle 11 ruote. Grazie in maniera anticipata

 

[salvo50]

Buona Pasqua a Tutti gli Utenti di questo fantastico Forum, chiedo venia sarebbe possibile modificare lo script per evidenziare solo gli estratti uguali isotopi in due ruote delle 11 ruote. Grazie in maniera anticipata

Ciao a Tutti

Non sono sicuro di aver capito bene, nel post 973 ho aggiunto un altro script vedi se può andare.

 

[salvo50]

Il secondo script del post 973 è da riprendere perché ho inserito tutte le ruote

 

[filippo1963]

Ciao a Tutti

Non sono sicuro di aver capito bene, nel post 973 ho aggiunto un altro script vedi se può andare.

Testato è si ottiene un bel 93% di esiti positivi

 

[EVERITA C]

Buongiorno e buona Pasqua a tutti voi.

 

[doris20]

Buona Pasqua al Forum

 

[mastrogino]

Buongiorno a tutti voi nel ringraziare Salvo per il suo altruismo e collaborazione per i suoi servizi ,
vi inserisco una previsione ottenuta da questo listato usando i vertibili , sperando che sia positiva nel minor tempo possibile
e se andra' in vincita vi svelo il modo di come e stato usato .
VI RINOVO GLI AUGURI DI UNA SANTA E PACE PASQUA 2025 A TUTTI

CA TT
89.88.62.26........89.62.
89.88.61.28.
89.88.32.84.
89.88.05.56........89.05.
89.88.10.78.

 

[bubù]

Buonasera,
Salvo50 intanto chiedo scusa per il disturbo, se si può fare uno script che cerchi su ruote consecutive tre numeri con stessa figura (in questo caso Fig 4) ma può essere anche diversa, e con distanza 18 e 27 in modo da formare 2 figure geometriche come da esempio.

Grazie e Buona serata a Tutti
​

 

[salvo50]

Ciao a Tutti

Mastrogino
Grazie

Nessun disturbo, appena posso lo faccio

 

[salvo50]

Ciao a Tutti

Option Explicit
Sub Main
   Dim FIn,Ini,A,B,C,D,E,F,Es,Cer,Clp
   Dim R1,R2,P1,P2,P3,P4,Salvo50,Sp
   Dim MaxAB,MaxCD,MinAB,MinCD,Caso,Casi
   Dim DistAB,DistCD,DistAD,DistAC,DistBD,DistBC
   Dim Abb1,Abb2,Abb3,Abb4
   Dim X(4),Y(5),Z(5)
   Dim Amba1(1),Amba2(1),Ambo1(2),Ambo2(2),Ambo3(2),Ambo4(2),Ambo5(2)
   Dim Terno1(3),Terno2(3),Penta(5),Po1(1),Po2(2),Po3(3),Po4(5),Ruote(2)
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,10000))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,13))
   Cer = CInt(InputBox(" Vuoi visualizzare il cerchio ciclometrico? SI = 1, NO un qualsiasi altro numero ",Salvo50,1))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(14) & "Ruote Consecutive 2 Distanze con Numero Comune - Script Salvo50 " & Space(14),1,,4,,3,,1
   Po1(1) = 1
   Po2(2) = 1
   Po3(2) = 1
   Po3(3) = 1
   Po4(2) = 1
   Po4(3) = 1
   Po4(4) = 1
   Po4(5) = 1
   Sp = " "
   For Es = Ini To FIn
      Messaggio Es & "    Tempo Trascorso" & TempoTrascorso
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es,R1,P1)
               B = Estratto(Es,R1,P2)
               R2 = R1 + 1
               If R2 = 11 Then R2 = 1
               For P3 = 1 To 4
                  For P4 = P3 + 1 To 5
                     C = Estratto(Es,R2,P3)
                     D = Estratto(Es,R2,P4)
                     If A > 0 And C > 0 Then
                        MinAB = Minimo(A,B) : MinCD = Minimo(C,D) : MaxAB = Massimo(A,B) : MaxCD = Massimo(C,D)
                        DistAB = Distanza(A,B) : DistCD = Distanza(C,D) : DistAD = Distanza(A,D)
                        DistAC = Distanza(A,C) : DistBD = Distanza(B,D) : DistBC = Distanza(B,C)
                        If(DistAB = 18 And DistCD = 27)Or(DistAB = 27 And DistCD = 18) Then
                           If MaxAB = MinCD Or MinAB = MaxCD Or MaxAB = MaxCD Or MinAB = MinCD Then
                              '
                              If DistAD > 17 And DistAC > 17 And DistBD > 17 And DistBC > 17 Then
                                 '
                                 If(DistAB = 18 And DistCD = 27) And(MinAB = MinCD) Then
                                    E = Diametrale(MinAB)
                                    F = Fuori90(MaxCD + 27)
                                    If F = MinCD Then F = Fuori90((90 + MaxCD) - 27)
                                 End If
                                 If(DistAB = 27 And DistCD = 18) And(MinAB = MinCD) Then
                                    E = Diametrale(MinAB)
                                    F = Fuori90(MaxCD + 18)
                                    If F = MinCD Then F = Fuori90((90 + MaxCD) - 18)
                                 End If
                                 If(DistAB = 18 And DistCD = 27) And(MaxAB = MaxCD) Then
                                    E = Diametrale(MaxAB)
                                    F = Fuori90(MinCD + 27)
                                    If F = MaxCD Then F = Fuori90((90 + MinCD) - 27)
                                 End If
                                 If(DistAB = 27 And DistCD = 18) And(MaxAB = MaxCD) Then
                                    E = Diametrale(MaxAB)
                                    F = Fuori90(MinAB + 27)
                                    If F = MaxAB Then F = Fuori90((90 + MinAB) - 27)
                                 End If
                                 If(DistAB = 27 And DistCD = 18) And(MaxAB = MinCD) Then
                                    E = Diametrale(MaxAB)
                                    F = Fuori90(MaxCD + 18)
                                    If F = MinCD Then F = Fuori90((90 + MaxCD) - 18)
                                 End If
                                 If(DistAB = 18 And DistCD = 27) And(MaxAB = MinCD) Then
                                    E = Diametrale(MaxAB)
                                    F = Fuori90(MaxCD + 27)
                                    If F = MinCD Then F = Fuori90((90 + MaxCD) - 27)
                                 End If
                                 If(DistAB = 18 And DistCD = 27) And(MinAB = MaxCD) Then
                                    E = Diametrale(MinAB)
                                    F = Fuori90(MaxAB + 18)
                                    If F = MinAB Then F = Fuori90((90 + MaxAB) - 18)
                                 End If
                                 If(DistAB = 27 And DistCD = 18) And(MinAB = MaxCD) Then
                                    E = Diametrale(MinAB)
                                    F = Fuori90(MaxAB + 27)
                                    If F = MinAB Then F = Fuori90((90 + MaxAB) - 27)
                                 End If
                                 Abb1 = Fuori90(F + 9) : Abb2 = Fuori90(F + 27)
                                 Abb3 = Fuori90(E + 36) : Abb4 = Diametrale(Abb3)
                                 X(1) = A : X(2) = B : X(3) = C : X(4) = D
                                 Y(1) = A : Y(2) = B : Y(3) = C : Y(4) = D : Y(5) = E
                                 Z(1) = A : Z(2) = B : Z(3) = C : Z(4) = D : Z(5) = F
                                 Amba1(1) = F
                                 Amba2(1) = E
                                 '
                                 Ambo1(1) = F : Ambo1(2) = E
                                 '
                                 Ambo2(1) = F : Ambo2(2) = Abb1
                                 Ambo3(1) = F : Ambo3(2) = Abb2
                                 '
                                 Ambo4(1) = E : Ambo4(2) = Abb3
                                 Ambo5(1) = E : Ambo5(2) = Abb4
                                 '
                                 Terno1(1) = F : Terno1(2) = Abb1 : Terno1(3) = Abb2
                                 Terno2(1) = E : Terno2(2) = Abb3 : Terno2(3) = Abb4
                                 '
                                 Penta(1) = Abb1 : Penta(2) = Abb2 : Penta(3) = Abb4 : Penta(4) = F : Penta(5) = E
                                 '        Terna(1) = N(1): Terna(2) = N(2): Terna(3) = N(3)
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,1
                                 Scrivi String(80,"*") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000"),1,,,2
                                 Scrivi
                                 ReDim MatrCasella(4,1)
                                 MatrCasella(1,0) = R1
                                 MatrCasella(1,1) = P1
                                 MatrCasella(2,0) = R1
                                 MatrCasella(2,1) = P2
                                 MatrCasella(3,0) = R2
                                 MatrCasella(3,1) = P3
                                 MatrCasella(4,0) = R2
                                 MatrCasella(4,1) = P4
                                 Call DisegnaEstrazione(Es,MatrCasella,,vbBlue)
                                 Scrivi
                                 If Cer = 1 Then
                                    DisegnaCerchioCiclometrico X,1,1,,,1,1
                                    DisegnaCerchioCiclometrico Y,1,1,,,1,1
                                    DisegnaCerchioCiclometrico Z,1,1,,,1,1
                                 End If
                                 Scrivi
                                 Scrivi
                                 Ruote(1) = R1 : Ruote(2) = R2
                                 ImpostaGiocata 1,Amba1,Ruote,Po1,Clp,1
                                 ImpostaGiocata 2,Amba2,Ruote,Po1,Clp,1
                                 ImpostaGiocata 3,Ambo1,Ruote,Po2,Clp,2
                                 ImpostaGiocata 4,Ambo2,Ruote,Po2,Clp,2
                                 ImpostaGiocata 5,Ambo3,Ruote,Po2,Clp,2
                                 ImpostaGiocata 6,Ambo4,Ruote,Po2,Clp,2
                                 ImpostaGiocata 7,Ambo5,Ruote,Po2,Clp,2
                                 ImpostaGiocata 8,Terno1,Ruote,Po3,Clp
                                 ImpostaGiocata 9,Terno2,Ruote,Po3,Clp
                                 ImpostaGiocata 10,Penta,Ruote,Po4,Clp
                                 Gioca Es,1
                              End If
                           End If
                        End If
                     End If
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
   Scrivi " Tempo Trascorso" & TempoTrascorso
End Sub

 

[mastrogino]

Buongiorno a tutti voi nel ringraziare Salvo per il suo altruismo e collaborazione per i suoi servizi ,
vi inserisco una previsione ottenuta da questo listato usando i vertibili , sperando che sia positiva nel minor tempo possibile
e se andra' in vincita vi svelo il modo di come e stato usato .
VI RINOVO GLI AUGURI DI UNA SANTA E PACE PASQUA 2025 A TUTTI

CA TT
89.88.62.26..........89.26.TT
89.88.61.28.
89.88.32.84...........89.32.TT
89.88.05.56............88.05. SU RUOTA DI CAGLIARI
89.88.10.78.