Novità

Script su Metodi Cabalistici, Ciclometrici & C.

salvo50

Advanced Member >PLATINUM PLUS<
Piacere Salvo,
sto osservando tutti gli script per cercare da autodidatta di imparare qualcosa di codice di programmazione dal tuo enorme lavoro. Ma ahimé non sono ancora riuscito a portare a casa neanche un calcolo (se non con i copia/incolla).
A questo punto ti chiederei una cortesia, se mai dovessi avere tempo, per uno script su questo metodo che io ho chiamato Forza4 (gioco sulla diagonale) e che non escludo possa aver "teorizzato" qualcuno prima di me.

Condizioni di gioco
Individuare una diagonale (sx verso dx) con i primi due elementi "in cadenza"

Giocata
2 ambate (3° e 4° elemento della diagonale) - Esito molto positivo da settembre ad oggi

Per costruzione ambi secchi (somma di 1°+4° della diagonale; somma di 2°+3° della diagonale) - DA VERIFICARE (sono alla ricerca di un buon gioco per ambo)

Nell'immagine ho provato a specificare sia le condizioni di rilevamento, sia quelle di giocata.
Nello specifico quella giocata ha portato una ambata al secondo colpo su Roma (estratto il 63)

Scusa e grazie per l'aiuto.
Ciao a Tutti.

Matematico, Rudivall
Grazie


FORZA4 (Gioco Sulla Diagonale) a cura di GIOVANNI81

Quali ruote usare nella ricerca non l'ho capito, quindi io le ho messe tutte e quattro, le due ruote con la cadenza e le due ruote col pronostico, quindi i due numeri del pronostico li ho giocati per ambata e ambo su quattro ruote, se vuoi che li cambio, spiegamelo con più dettagli.
Ho visualizzato tutte le estrazioni, mi dispiace ma non sono riuscito ad evidenziare le cadenze consecutive ed i pronostici.

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp,Salvo50,Sp,Casi,G,R,P,k,X,Ok2
   Dim BA(2),CA(3),FI(4),GE(5),MI(5),NA(5),PA(5),RO(5),TR(5),VE(5)
   Dim R1(4),R2(4),R3(4),R4(4),R5(4),R6(4),R7(4),E(5),Ok(14),Poste(2)
   Dim Amba1(2),Amba2(2),Amba3(2),Amba4(2),Amba5(2),Amba6(2),Amba7(2)
   Dim Amba8(2),Amba9(2),Amba10(2),Amba11(2),Amba12(2),Amba13(2),Amba14(2)
   Poste(1) = 1
   Poste(2) = 1
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9700)
   Clp = InputBox("Inserisci i colpi di gioco ?",,5)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(7) & " FORZA4 (Gioco Sulla Diagonale) a cura di GIOVANNI81 - SCRIPT Salvo50" & Space(7),1,,4,,3,,1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      BA(1) = Estratto(Es,BA_,1) : BA(2) = Estratto(Es,BA_,2)
      CA(1) = Estratto(Es,CA_,1) : CA(2) = Estratto(Es,CA_,2) : CA(3) = Estratto(Es,CA_,3)
      FI(1) = Estratto(Es,FI_,1) : FI(2) = Estratto(Es,FI_,2) : FI(3) = Estratto(Es,FI_,3) : FI(4) = Estratto(Es,FI_,4)
      GE(1) = Estratto(Es,GE_,1) : GE(2) = Estratto(Es,GE_,2) : GE(3) = Estratto(Es,GE_,3) : GE(4) = Estratto(Es,GE_,4)
      GE(5) = Estratto(Es,GE_,5)
      MI(1) = Estratto(Es,MI_,1) : MI(2) = Estratto(Es,MI_,2) : MI(3) = Estratto(Es,MI_,3) : MI(4) = Estratto(Es,MI_,4)
      MI(5) = Estratto(Es,MI_,5)
      NA(1) = Estratto(Es,NA_,1) : NA(2) = Estratto(Es,NA_,2) : NA(3) = Estratto(Es,NA_,3) : NA(4) = Estratto(Es,NA_,4)
      NA(5) = Estratto(Es,NA_,5)
      PA(1) = Estratto(Es,PA_,1) : PA(2) = Estratto(Es,PA_,2) : PA(3) = Estratto(Es,PA_,3) : PA(4) = Estratto(Es,PA_,4)
      PA(5) = Estratto(Es,PA_,5)
      RO(2) = Estratto(Es,RO_,2) : RO(3) = Estratto(Es,RO_,3) : RO(4) = Estratto(Es,RO_,4) : RO(5) = Estratto(Es,RO_,5)
      TR(3) = Estratto(Es,TO_,3) : TR(4) = Estratto(Es,TO_,4) : TR(5) = Estratto(Es,TO_,5)
      VE(4) = Estratto(Es,VE_,4) : VE(5) = Estratto(Es,VE_,5)
      For k = 1 To 14
         Ok(k) = 0
      Next
      If Cadenza(BA(2)) = Cadenza(CA(3)) Then
         Amba1(1) = FI(4) : Amba1(2) = GE(5)
         R1(1) = BA_ : R1(2) = CA_ : R1(3) = FI_ : R1(4) = GE_
         Ok(1) = 1
      End If
      If Cadenza(BA(1)) = Cadenza(CA(2)) Then
         Amba2(1) = FI(3) : Amba2(2) = GE(4)
         R1(1) = BA_ : R1(2) = CA_ : R1(3) = FI_ : R1(4) = GE_
         Ok(2) = 1
      End If
      '--------------------------------
      If Cadenza(CA(2)) = Cadenza(FI(3)) Then
         Amba3(1) = GE(4) : Amba3(2) = MI(5)
         R2(1) = CA_ : R2(2) = FI_ : R2(3) = GE_ : R2(4) = MI_
         Ok(3) = 1
      End If
      If Cadenza(CA(1)) = Cadenza(FI(2)) Then
         Amba4(1) = GE(3) : Amba4(2) = MI(4)
         R2(1) = CA_ : R2(2) = FI_ : R2(3) = GE_ : R2(4) = MI_
         Ok(4) = 1
      End If
      '----------------------------------
      If Cadenza(FI(2)) = Cadenza(GE(3)) Then
         Amba5(1) = MI(4) : Amba5(2) = NA(5)
         R3(1) = FI_ : R3(2) = GE_ : R3(3) = MI_ : R3(4) = NA_
         Ok(5) = 1
      End If
      If Cadenza(FI(1)) = Cadenza(GE(2)) Then
         Amba6(1) = MI(3) : Amba6(2) = NA(4)
         R3(1) = FI_ : R3(2) = GE_ : R3(3) = MI_ : R3(4) = NA_
         Ok(6) = 1
      End If
      '---------------------------------------
      If Cadenza(GE(2)) = Cadenza(MI(3)) Then
         Amba7(1) = NA(4) : Amba7(2) = PA(5)
         R4(1) = GE_ : R4(2) = MI_ : R4(3) = NA_ : R4(4) = PA_
         Ok(7) = 1
      End If
      If Cadenza(GE(1)) = Cadenza(MI(2)) Then
         Amba8(1) = NA(3) : Amba8(2) = PA(4)
         R4(1) = GE_ : R4(2) = MI_ : R4(3) = NA_ : R4(4) = PA_
         Ok(8) = 1
      End If
      '------------------------------------------------
      If Cadenza(MI(2)) = Cadenza(NA(3)) Then
         Amba9(1) = PA(4) : Amba9(2) = RO(5)
         R5(1) = MI_ : R5(2) = NA_ : R5(3) = PA_ : R5(4) = RO_
         Ok(9) = 1
      End If
      If Cadenza(MI(1)) = Cadenza(NA(2)) Then
         Amba10(1) = PA(3) : Amba10(2) = RO(4)
         R5(1) = MI_ : R5(2) = NA_ : R5(3) = PA_ : R5(4) = RO_
         Ok(10) = 1
      End If
      '---------------------------------------
      If Cadenza(NA(2)) = Cadenza(PA(3)) Then
         Amba11(1) = RO(4) : Amba11(2) = TR(5)
         R6(1) = NA_ : R6(2) = PA_ : R6(3) = RO_ : R6(4) = TO_
         Ok(11) = 1
      End If
      If Cadenza(NA(1)) = Cadenza(PA(2)) Then
         Amba12(1) = RO(3) : Amba12(2) = TR(4)
         R6(1) = NA_ : R6(2) = PA_ : R6(3) = RO_ : R6(4) = TO_
         Ok(12) = 1
      End If
      '-----------------------------------------------
      If Cadenza(PA(2)) = Cadenza(RO(3)) Then
         Amba13(1) = TR(4) : Amba13(2) = VE(5)
         R7(1) = PA_ : R7(2) = RO_ : R7(3) = TO_ : R7(4) = VE_
         Ok(13) = 1
      End If
      If Cadenza(PA(1)) = Cadenza(RO(2)) Then
         Amba14(1) = TR(3) : Amba14(2) = VE(4)
         R7(1) = PA_ : R7(2) = RO_ : R7(3) = TO_ : R7(4) = VE_
         Ok(14) = 1
      End If
      '-----------------------------------------
      Ok2 = 0
      For X = 1 To 14
         If Ok(X) = 1 Then Ok2 = 1 : Exit For
      Next
      If Ok2 = 1 Then
         Casi = Casi + 1
         Scrivi String(96,"o") & " Caso " & FormattaStringa(Casi,"0000"),1,,,1
         Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1
         For R = 1 To 10
            Scrivi Space(16) & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E(P) = Estratto(Es,R,P)
            Next
            Scrivi StringaNumeri(E," ",True),1
         Next
         Scrivi
         G = 1
         If Ok(1) = 1 Then ImpostaGiocata G,Amba1,R1,Poste,Clp : G = G + 1
         If Ok(2) = 1 Then ImpostaGiocata G,Amba2,R1,Poste,Clp : G = G + 1
         If Ok(3) = 1 Then ImpostaGiocata G,Amba3,R2,Poste,Clp : G = G + 1
         If Ok(4) = 1 Then ImpostaGiocata G,Amba4,R2,Poste,Clp : G = G + 1
         If Ok(5) = 1 Then ImpostaGiocata G,Amba5,R3,Poste,Clp : G = G + 1
         If Ok(6) = 1 Then ImpostaGiocata G,Amba6,R3,Poste,Clp : G = G + 1
         If Ok(7) = 1 Then ImpostaGiocata G,Amba7,R4,Poste,Clp : G = G + 1
         If Ok(8) = 1 Then ImpostaGiocata G,Amba8,R4,Poste,Clp : G = G + 1
         If Ok(9) = 1 Then ImpostaGiocata G,Amba9,R5,Poste,Clp : G = G + 1
         If Ok(10) = 1 Then ImpostaGiocata G,Amba10,R5,Poste,Clp : G = G + 1
         If Ok(11) = 1 Then ImpostaGiocata G,Amba11,R6,Poste,Clp : G = G + 1
         If Ok(12) = 1 Then ImpostaGiocata G,Amba12,R6,Poste,Clp : G = G + 1
         If Ok(13) = 1 Then ImpostaGiocata G,Amba13,R7,Poste,Clp : G = G + 1
         If Ok(14) = 1 Then ImpostaGiocata G,Amba14,R7,Poste,Clp
         Gioca Es,,,1
      End If
   Next
   ScriviResoconto
   Scrivi TempoTrascorso
End Sub
 
Ultima modifica:

Matematico

Advanced Member
Bravissimo Salvo come sempre precisissimo, sono molto contento che hai fatto lo script pare che ancora va benissimo questo mio metodo, un grazie anche a Matematico per averlo proposto. Salutoni a tutti. Franco Mongillo
E si molto bravo davvero salvo50 ..un grazie immenso x i suoi script ottimi, grazie anche a te Franco x le tue metodologie ancora attuali e funzionanti :)

Buona giornata a tutti
 

Giovanni81

Junior Member
Ciao a Tutti.

Matematico, Rudivall
Grazie


FORZA4 (Gioco Sulla Diagonale) a cura di GIOVANNI81

Quali ruote usare nella ricerca non l'ho capito, quindi io le ho messe tutte e quattro, le due ruote con la cadenza e le due ruote col pronostico, quindi i due numeri del pronostico li ho giocati per ambata e ambo su quattro ruote, se vuoi che li cambio, spiegamelo con più dettagli.
Ho visualizzato tutte le estrazioni, mi dispiace ma non sono riuscito ad evidenziare le cadenze consecutive ed i pronostici.

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp,Salvo50,Sp,Casi,G,R,P,k,X,Ok2
   Dim BA(2),CA(3),FI(4),GE(5),MI(5),NA(5),PA(5),RO(5),TR(5),VE(5)
   Dim R1(4),R2(4),R3(4),R4(4),R5(4),R6(4),R7(4),E(5),Ok(14),Poste(2)
   Dim Amba1(2),Amba2(2),Amba3(2),Amba4(2),Amba5(2),Amba6(2),Amba7(2)
   Dim Amba8(2),Amba9(2),Amba10(2),Amba11(2),Amba12(2),Amba13(2),Amba14(2)
   Poste(1) = 1
   Poste(2) = 1
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9700)
   Clp = InputBox("Inserisci i colpi di gioco ?",,5)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(7) & " FORZA4 (Gioco Sulla Diagonale) a cura di GIOVANNI81 - SCRIPT Salvo50" & Space(7),1,,4,,3,,1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      BA(1) = Estratto(Es,BA_,1) : BA(2) = Estratto(Es,BA_,2)
      CA(1) = Estratto(Es,CA_,1) : CA(2) = Estratto(Es,CA_,2) : CA(3) = Estratto(Es,CA_,3)
      FI(1) = Estratto(Es,FI_,1) : FI(2) = Estratto(Es,FI_,2) : FI(3) = Estratto(Es,FI_,3) : FI(4) = Estratto(Es,FI_,4)
      GE(1) = Estratto(Es,GE_,1) : GE(2) = Estratto(Es,GE_,2) : GE(3) = Estratto(Es,GE_,3) : GE(4) = Estratto(Es,GE_,4)
      GE(5) = Estratto(Es,GE_,5)
      MI(1) = Estratto(Es,MI_,1) : MI(2) = Estratto(Es,MI_,2) : MI(3) = Estratto(Es,MI_,3) : MI(4) = Estratto(Es,MI_,4)
      MI(5) = Estratto(Es,MI_,5)
      NA(1) = Estratto(Es,NA_,1) : NA(2) = Estratto(Es,NA_,2) : NA(3) = Estratto(Es,NA_,3) : NA(4) = Estratto(Es,NA_,4)
      NA(5) = Estratto(Es,NA_,5)
      PA(1) = Estratto(Es,PA_,1) : PA(2) = Estratto(Es,PA_,2) : PA(3) = Estratto(Es,PA_,3) : PA(4) = Estratto(Es,PA_,4)
      PA(5) = Estratto(Es,PA_,5)
      RO(2) = Estratto(Es,RO_,2) : RO(3) = Estratto(Es,RO_,3) : RO(4) = Estratto(Es,RO_,4) : RO(5) = Estratto(Es,RO_,5)
      TR(3) = Estratto(Es,TO_,3) : TR(4) = Estratto(Es,TO_,4) : TR(5) = Estratto(Es,TO_,5)
      VE(4) = Estratto(Es,VE_,4) : VE(5) = Estratto(Es,VE_,5)
      For k = 1 To 14
         Ok(k) = 0
      Next
      If Cadenza(BA(2)) = Cadenza(CA(3)) Then
         Amba1(1) = FI(4) : Amba1(2) = GE(5)
         R1(1) = BA_ : R1(2) = CA_ : R1(3) = FI_ : R1(4) = GE_
         Ok(1) = 1
      End If
      If Cadenza(BA(1)) = Cadenza(CA(2)) Then
         Amba2(1) = FI(3) : Amba2(2) = GE(4)
         R1(1) = BA_ : R1(2) = CA_ : R1(3) = FI_ : R1(4) = GE_
         Ok(2) = 1
      End If
      '--------------------------------
      If Cadenza(CA(2)) = Cadenza(FI(3)) Then
         Amba3(1) = GE(4) : Amba3(2) = MI(5)
         R2(1) = CA_ : R2(2) = FI_ : R2(3) = GE_ : R2(4) = MI_
         Ok(3) = 1
      End If
      If Cadenza(CA(1)) = Cadenza(FI(2)) Then
         Amba4(1) = GE(3) : Amba4(2) = MI(4)
         R2(1) = CA_ : R2(2) = FI_ : R2(3) = GE_ : R2(4) = MI_
         Ok(4) = 1
      End If
      '----------------------------------
      If Cadenza(FI(2)) = Cadenza(GE(3)) Then
         Amba5(1) = MI(4) : Amba5(2) = NA(5)
         R3(1) = FI_ : R3(2) = GE_ : R3(3) = MI_ : R3(4) = NA_
         Ok(5) = 1
      End If
      If Cadenza(FI(1)) = Cadenza(GE(2)) Then
         Amba6(1) = MI(3) : Amba6(2) = NA(4)
         R3(1) = FI_ : R3(2) = GE_ : R3(3) = MI_ : R3(4) = NA_
         Ok(6) = 1
      End If
      '---------------------------------------
      If Cadenza(GE(2)) = Cadenza(MI(3)) Then
         Amba7(1) = NA(4) : Amba7(2) = PA(5)
         R4(1) = GE_ : R4(2) = MI_ : R4(3) = NA_ : R4(4) = PA_
         Ok(7) = 1
      End If
      If Cadenza(GE(1)) = Cadenza(MI(2)) Then
         Amba8(1) = NA(3) : Amba8(2) = PA(4)
         R4(1) = GE_ : R4(2) = MI_ : R4(3) = NA_ : R4(4) = PA_
         Ok(8) = 1
      End If
      '------------------------------------------------
      If Cadenza(MI(2)) = Cadenza(NA(3)) Then
         Amba9(1) = PA(4) : Amba9(2) = RO(5)
         R5(1) = MI_ : R5(2) = NA_ : R5(3) = PA_ : R5(4) = RO_
         Ok(9) = 1
      End If
      If Cadenza(MI(1)) = Cadenza(NA(2)) Then
         Amba10(1) = PA(3) : Amba10(2) = RO(4)
         R5(1) = MI_ : R5(2) = NA_ : R5(3) = PA_ : R5(4) = RO_
         Ok(10) = 1
      End If
      '---------------------------------------
      If Cadenza(NA(2)) = Cadenza(PA(3)) Then
         Amba11(1) = RO(4) : Amba11(2) = TR(5)
         R6(1) = NA_ : R6(2) = PA_ : R6(3) = RO_ : R6(4) = TO_
         Ok(11) = 1
      End If
      If Cadenza(NA(1)) = Cadenza(PA(2)) Then
         Amba12(1) = RO(3) : Amba12(2) = TR(4)
         R6(1) = NA_ : R6(2) = PA_ : R6(3) = RO_ : R6(4) = TO_
         Ok(12) = 1
      End If
      '-----------------------------------------------
      If Cadenza(PA(2)) = Cadenza(RO(3)) Then
         Amba13(1) = TR(4) : Amba13(2) = VE(5)
         R7(1) = PA_ : R7(2) = RO_ : R7(3) = TO_ : R7(4) = VE_
         Ok(13) = 1
      End If
      If Cadenza(PA(1)) = Cadenza(RO(2)) Then
         Amba14(1) = TR(3) : Amba14(2) = VE(4)
         R7(1) = PA_ : R7(2) = RO_ : R7(3) = TO_ : R7(4) = VE_
         Ok(14) = 1
      End If
      '-----------------------------------------
      Ok2 = 0
      For X = 1 To 14
         If Ok(X) = 1 Then Ok2 = 1 : Exit For
      Next
      If Ok2 = 1 Then
         Casi = Casi + 1
         Scrivi String(96,"o") & " Caso " & FormattaStringa(Casi,"0000"),1,,,1
         Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1
         For R = 1 To 10
            Scrivi Space(16) & SiglaRuota(R) & " ",1,0
            For P = 1 To 5
               E(P) = Estratto(Es,R,P)
            Next
            Scrivi StringaNumeri(E," ",True),1
         Next
         Scrivi
         G = 1
         If Ok(1) = 1 Then ImpostaGiocata G,Amba1,R1,Poste,Clp : G = G + 1
         If Ok(2) = 1 Then ImpostaGiocata G,Amba2,R1,Poste,Clp : G = G + 1
         If Ok(3) = 1 Then ImpostaGiocata G,Amba3,R2,Poste,Clp : G = G + 1
         If Ok(4) = 1 Then ImpostaGiocata G,Amba4,R2,Poste,Clp : G = G + 1
         If Ok(5) = 1 Then ImpostaGiocata G,Amba5,R3,Poste,Clp : G = G + 1
         If Ok(6) = 1 Then ImpostaGiocata G,Amba6,R3,Poste,Clp : G = G + 1
         If Ok(7) = 1 Then ImpostaGiocata G,Amba7,R4,Poste,Clp : G = G + 1
         If Ok(8) = 1 Then ImpostaGiocata G,Amba8,R4,Poste,Clp : G = G + 1
         If Ok(9) = 1 Then ImpostaGiocata G,Amba9,R5,Poste,Clp : G = G + 1
         If Ok(10) = 1 Then ImpostaGiocata G,Amba10,R5,Poste,Clp : G = G + 1
         If Ok(11) = 1 Then ImpostaGiocata G,Amba11,R6,Poste,Clp : G = G + 1
         If Ok(12) = 1 Then ImpostaGiocata G,Amba12,R6,Poste,Clp : G = G + 1
         If Ok(13) = 1 Then ImpostaGiocata G,Amba13,R7,Poste,Clp : G = G + 1
         If Ok(14) = 1 Then ImpostaGiocata G,Amba14,R7,Poste,Clp
         Gioca Es,,,1
      End If
   Next
   ScriviResoconto
   Scrivi TempoTrascorso
End Sub
Salvo50 grazie di cuore. Strepitoso, i tuoi script sono talmente "chiari" che anche modificare i parametri è semplice. La ruota di gioco è una sola ed è quella del primo estratto (ad eccezione della diagonale che parte da BA2, che si gioca su Venezia - e di quella che parte da PA1 che si gioca su Roma). Questo sono riuscito a modificarlo in autonomia, ma visto che non ero stato preciso ci tenevo a dirtelo. Per ringraziarti ancora una volta.

Giusto una curiosità, come si può inserire il parametro (interrompi giocate all'esito positivo?)

Grazie, ancora Giovanni
 

salvo50

Advanced Member >PLATINUM PLUS<
Ciao Giovanni

If Ok(1) = 1 Then ImpostaGiocata G,Amba1,R1,Poste,Clp : G = G + 1
If Ok(2) = 1 Then ImpostaGiocata G,Amba2,R1,Poste,Clp : G = G + 1
If Ok(3) = 1 Then ImpostaGiocata G,Amba3,R2,Poste,Clp : G = G + 1
If Ok(4) = 1 Then ImpostaGiocata G,Amba4,R2,Poste,Clp : G = G + 1
If Ok(5) = 1 Then ImpostaGiocata G,Amba5,R3,Poste,Clp : G = G + 1
If Ok(6) = 1 Then ImpostaGiocata G,Amba6,R3,Poste,Clp : G = G + 1
If Ok(7) = 1 Then ImpostaGiocata G,Amba7,R4,Poste,Clp : G = G + 1
If Ok(8) = 1 Then ImpostaGiocata G,Amba8,R4,Poste,Clp : G = G + 1
If Ok(9) = 1 Then ImpostaGiocata G,Amba9,R5,Poste,Clp : G = G + 1
If Ok(10) = 1 Then ImpostaGiocata G,Amba10,R5,Poste,Clp : G = G + 1
If Ok(11) = 1 Then ImpostaGiocata G,Amba11,R6,Poste,Clp : G = G + 1
If Ok(12) = 1 Then ImpostaGiocata G,Amba12,R6,Poste,Clp : G = G + 1
If Ok(13) = 1 Then ImpostaGiocata G,Amba13,R7,Poste,Clp : G = G + 1
If Ok(14) = 1 Then ImpostaGiocata G,Amba14,R7,Poste,Clp

in queste righe dopo Clp e prima dei 2 punti

If Ok(13) = 1 Then ImpostaGiocata G,Amba13,R7,Poste,Clp,1 : G = G + 1
If Ok(13) = 1 Then ImpostaGiocata G,Amba13,R7,Poste,Clp,2 : G = G + 1

metti virgola 1(,1) se vuoi che si fermi alla prima ambata
metti virgola 2(,2) se vuoi che si fermi al primo ambo

se i numeri fossero più di 2, con ,3 si ferma al primo terno ecc...
 

salvo50

Advanced Member >PLATINUM PLUS<
Ciao a Tutti.

Franco2761, Giovanni81, Matematico, Rudivall, Xeroxs
Grazie!



IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO

Può capitare che si avverano delle distanze uguali superiori a 2, in questo caso lo script esegue solo l'ultima e se la prima era fattibile e l'ultima no (non era fattibile) , lo script scarta la combinazione, mi dispiace ma non sono riuscito a fare di meglio.


Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,Es,Clp,Salvo50,Caso,Casi
   Dim R1,R2,A,B,P1,P2,P5,P6,E1,E2,Sp
   Dim Dist2A,Dist3A,Dist4A,Dist5A
   Dim Dist2B,Dist3B,Dist4B,Dist5B
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),B1(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9830)
   Clp = InputBox("Per quanti colpi vuoi giocare la quartina?",,13)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(2) = 1
   Posta(3) = 1
   'Posta(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            If A > 0 Then
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B > 0 Then
                        If B = Diametrale(A) Then
                           k1 = 0
                           For k1 = 1 To 5
                              A1(k1) = Estratto(Es,R1,k1)
                              If A1(k1) = A Then A1(k1) = 0
                           Next
                           Call OrdinaMatrice(A1,1)
                           Dist2A = Distanza(A,A1(2)) : Dist3A = Distanza(A,A1(3))
                           Dist4A = Distanza(A,A1(4)) : Dist5A = Distanza(A,A1(5))
                           '
                           K2 = 0
                           For K2 = 1 To 5
                              B1(K2) = Estratto(Es,R2,K2)
                              If B1(K2) = B Then B1(K2) = 0
                           Next
                           Call OrdinaMatrice(B1,1)
                           Dist2B = Distanza(B,B1(2)) : Dist3B = Distanza(B,B1(3))
                           Dist4B = Distanza(B,B1(4)) : Dist5B = Distanza(B,B1(5))
                           UgA = 0 : UgB = 0
                           If Dist2A = Dist2B Then XA = A1(2) : XB = B1(2) : UgA = Dist2A : UgB = Dist2B
                           If Dist2A = Dist3B Then XA = A1(2) : XB = B1(3) : UgA = Dist2A : UgB = Dist3B
                           If Dist2A = Dist4B Then XA = A1(2) : XB = B1(4) : UgA = Dist2A : UgB = Dist4B
                           If Dist2A = Dist5B Then XA = A1(2) : XB = B1(5) : UgA = Dist2A : UgB = Dist5B
                           '
                           If Dist3A = Dist2B Then XA = A1(3) : XB = B1(2) : UgA = Dist3A : UgB = Dist2B
                           If Dist3A = Dist3B Then XA = A1(3) : XB = B1(3) : UgA = Dist3A : UgB = Dist3B
                           If Dist3A = Dist4B Then XA = A1(3) : XB = B1(4) : UgA = Dist3A : UgB = Dist4B
                           If Dist3A = Dist5B Then XA = A1(3) : XB = B1(5) : UgA = Dist3A : UgB = Dist5B
                           '
                           If Dist4A = Dist2B Then XA = A1(4) : XB = B1(2) : UgA = Dist4A : UgB = Dist2B
                           If Dist4A = Dist3B Then XA = A1(4) : XB = B1(3) : UgA = Dist4A : UgB = Dist3B
                           If Dist4A = Dist4B Then XA = A1(4) : XB = B1(4) : UgA = Dist4A : UgB = Dist4B
                           If Dist4A = Dist5B Then XA = A1(4) : XB = B1(5) : UgA = Dist4A : UgB = Dist5B
                           '
                           If Dist5A = Dist2B Then XA = A1(5) : XB = B1(2) : UgA = Dist5A : UgB = Dist2B
                           If Dist5A = Dist3B Then XA = A1(5) : XB = B1(3) : UgA = Dist5A : UgB = Dist3B
                           If Dist5A = Dist4B Then XA = A1(5) : XB = B1(4) : UgA = Dist5A : UgB = Dist4B
                           If Dist5A = Dist5B Then XA = A1(5) : XB = B1(5) : UgA = Dist5A : UgB = Dist5B
                           If UgA = UgB And UgA > 0 Then
                              Nu1 = 0 : Nu2 = 0 : Nu3 = 0 : Nu4 = 0
                              If XB <> Diametrale(XA) Then
                                 If pari(A) And pari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XB)Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XA)Then Call Calcoli(A,XA,XB,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XB) Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XA)Then Call Calcoli(A,XA,B,XB,Nu1,Nu2,Nu3,Nu4)
                                 Qua(1) = Nu1 : Qua(2) = Nu2 : Qua(3) = Nu3 : Qua(4) = Nu4
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 ColoreTesto 1
                                 Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                 ColoreTesto 2
                                 Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                 ColoreTesto 0
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                                 For P5 = 1 To 5
                                    E1 = Estratto(Es,R1,P5)
                                    If E1 = A Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    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 P6 = 1 To 5
                                    E2 = Estratto(Es,R2,P6)
                                    If E2 = B Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(2)) & " = Distanza " & Format2(Dist2A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(2)) & " = Distanza " & Format2(Dist2B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(3)) & " = Distanza " & Format2(Dist3A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(3)) & " = Distanza " & Format2(Dist3B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(4)) & " = Distanza " & Format2(Dist4A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(4)) & " = Distanza " & Format2(Dist4B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(5)) & " = Distanza " & Format2(Dist5A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(5)) & " = Distanza " & Format2(Dist5B),1
                                 Scrivi
                                 Scrivi Space(17) & " La Distanza Uguale è " & Format2(UgA),1
                                 Scrivi Space(17) & "Pronostico   " & StringaNumeri(Qua," ",True),1
                               
                                 Ruo(1) = R1 : Ruo(2) = R2
                                 ImpostaGiocata 1,Qua,Ruo,Posta,Clp
                                 Gioca Es
                              End If
                           End If
                        End If
                     End If
                  Next
               Next
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
Function Calcoli(N1,N2,N3,N4,Nu1,Nu2,Nu3,Nu4)
   Nu1 =((N1 + N2)\ 2)
   Nu2 = Diametrale(Nu1)
   Nu3 =((N3 + N4)\ 2)
   Nu4 = Diametrale(Nu3)
End Function
 
Ultima modifica:

Matematico

Advanced Member
Ciao a Tutti.

Franco2761, Giovanni81, Matematico, Rudivall, Xeroxs
Grazie!



IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO

Può capitare che si avverano delle presenze uguali superiori a 2, in questo caso lo script esegue solo l'ultimo e se il primo era fattibile e l'ultimo no (non era fattibile) , lo script scarta la combinazione, mi dispiace ma non sono riuscito a fare di meglio.


Codice:
Option Explicit
Sub Main
   Dim FIn,Ini,Es,Clp,Salvo50,Caso,Casi
   Dim R1,R2,A,B,P1,P2,P5,P6,E1,E2,Sp
   Dim Dist2A,Dist3A,Dist4A,Dist5A
   Dim Dist2B,Dist3B,Dist4B,Dist5B
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),B1(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9830)
   Clp = InputBox("Per quanti colpi vuoi giocare la quartina?",,13)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "IL RETTANGOLO ASSOLUTO di ANTONIO FIACCO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(2) = 1
   Posta(3) = 1
   'Posta(4) = 1
   For Es = Ini To FIn
      Messaggio Es
      AvanzamentoElab Ini,FIn,Es
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            A = Estratto(Es,R1,P1)
            If A > 0 Then
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B > 0 Then
                        If B = Diametrale(A) Then
                           k1 = 0
                           For k1 = 1 To 5
                              A1(k1) = Estratto(Es,R1,k1)
                              If A1(k1) = A Then A1(k1) = 0
                           Next
                           Call OrdinaMatrice(A1,1)
                           Dist2A = Distanza(A,A1(2)) : Dist3A = Distanza(A,A1(3))
                           Dist4A = Distanza(A,A1(4)) : Dist5A = Distanza(A,A1(5))
                           '
                           K2 = 0
                           For K2 = 1 To 5
                              B1(K2) = Estratto(Es,R2,K2)
                              If B1(K2) = B Then B1(K2) = 0
                           Next
                           Call OrdinaMatrice(B1,1)
                           Dist2B = Distanza(B,B1(2)) : Dist3B = Distanza(B,B1(3))
                           Dist4B = Distanza(B,B1(4)) : Dist5B = Distanza(B,B1(5))
                           UgA = 0 : UgB = 0
                           If Dist2A = Dist2B Then XA = A1(2) : XB = B1(2) : UgA = Dist2A : UgB = Dist2B
                           If Dist2A = Dist3B Then XA = A1(2) : XB = B1(3) : UgA = Dist2A : UgB = Dist3B
                           If Dist2A = Dist4B Then XA = A1(2) : XB = B1(4) : UgA = Dist2A : UgB = Dist4B
                           If Dist2A = Dist5B Then XA = A1(2) : XB = B1(5) : UgA = Dist2A : UgB = Dist5B
                           '
                           If Dist3A = Dist2B Then XA = A1(3) : XB = B1(2) : UgA = Dist3A : UgB = Dist2B
                           If Dist3A = Dist3B Then XA = A1(3) : XB = B1(3) : UgA = Dist3A : UgB = Dist3B
                           If Dist3A = Dist4B Then XA = A1(3) : XB = B1(4) : UgA = Dist3A : UgB = Dist4B
                           If Dist3A = Dist5B Then XA = A1(3) : XB = B1(5) : UgA = Dist3A : UgB = Dist5B
                           '
                           If Dist4A = Dist2B Then XA = A1(4) : XB = B1(2) : UgA = Dist4A : UgB = Dist2B
                           If Dist4A = Dist3B Then XA = A1(4) : XB = B1(3) : UgA = Dist4A : UgB = Dist3B
                           If Dist4A = Dist4B Then XA = A1(4) : XB = B1(4) : UgA = Dist4A : UgB = Dist4B
                           If Dist4A = Dist5B Then XA = A1(4) : XB = B1(5) : UgA = Dist4A : UgB = Dist5B
                           '
                           If Dist5A = Dist2B Then XA = A1(5) : XB = B1(2) : UgA = Dist5A : UgB = Dist2B
                           If Dist5A = Dist3B Then XA = A1(5) : XB = B1(3) : UgA = Dist5A : UgB = Dist3B
                           If Dist5A = Dist4B Then XA = A1(5) : XB = B1(4) : UgA = Dist5A : UgB = Dist4B
                           If Dist5A = Dist5B Then XA = A1(5) : XB = B1(5) : UgA = Dist5A : UgB = Dist5B
                           If UgA = UgB And UgA > 0 Then
                              Nu1 = 0 : Nu2 = 0 : Nu3 = 0 : Nu4 = 0
                              If XB <> Diametrale(XA) Then
                                 If pari(A) And pari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XB)Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If pari(A) And pari(XA)Then Call Calcoli(A,XA,XB,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XB) Then Call Calcoli(A,XB,XA,B,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(B)Then Call Calcoli(A,B,XA,XB,Nu1,Nu2,Nu3,Nu4)
                                 If dispari(A) And dispari(XA)Then Call Calcoli(A,XA,B,XB,Nu1,Nu2,Nu3,Nu4)
                                 Qua(1) = Nu1 : Qua(2) = Nu2 : Qua(3) = Nu3 : Qua(4) = Nu4
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 ColoreTesto 1
                                 Scrivi String(89,"o") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                 ColoreTesto 2
                                 Scrivi String(80,"o") & " Estrazione " &(Es) & " caso " & FormattaStringa(Caso,"0000")
                                 ColoreTesto 0
                                 Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & "  ",1,0
                                 For P5 = 1 To 5
                                    E1 = Estratto(Es,R1,P5)
                                    If E1 = A Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    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 P6 = 1 To 5
                                    E2 = Estratto(Es,R2,P6)
                                    If E2 = B Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi
                                 Scrivi
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(2)) & " = Distanza " & Format2(Dist2A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(2)) & " = Distanza " & Format2(Dist2B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(3)) & " = Distanza " & Format2(Dist3A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(3)) & " = Distanza " & Format2(Dist3B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(4)) & " = Distanza " & Format2(Dist4A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(4)) & " = Distanza " & Format2(Dist4B),1
                                 Scrivi Space(5) & Format2(A) & "-" & Format2(A1(5)) & " = Distanza " & Format2(Dist5A),1,0
                                 Scrivi Space(10) & Format2(B) & "-" & Format2(B1(5)) & " = Distanza " & Format2(Dist5B),1
                                 Scrivi
                                 Scrivi Space(17) & " La Distanza Uguale è " & Format2(UgA),1
                                 Scrivi Space(17) & "Pronostico   " & StringaNumeri(Qua," ",True),1
                                
                                 Ruo(1) = R1 : Ruo(2) = R2
                                 ImpostaGiocata 1,Qua,Ruo,Posta,Clp
                                 Gioca Es
                              End If
                           End If
                        End If
                     End If
                  Next
               Next
            End If
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
Function Calcoli(N1,N2,N3,N4,Nu1,Nu2,Nu3,Nu4)
   Nu1 =((N1 + N2)\ 2)
   Nu2 = Diametrale(Nu1)
   Nu3 =((N3 + N4)\ 2)
   Nu4 = Diametrale(Nu3)
End Function
Ciao a Tutti.
Giovanni81,Franco2761, Rudivall, Xeroxs.
Ottimo script salvo50, complimenti ! Ne ho altri in cartaceo ...appena ho il tempo di scannerizzarli li metto uno alla volta a disposizione di tutti , anche x quelli che non mettono il like soprattutto al gran lavoro di salvo 50...
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 24 novembre 2020
    Bari
    56
    45
    69
    74
    10
    Cagliari
    03
    75
    10
    33
    68
    Firenze
    06
    46
    45
    22
    66
    Genova
    21
    90
    46
    69
    56
    Milano
    58
    56
    44
    45
    21
    Napoli
    20
    32
    07
    62
    56
    Palermo
    48
    20
    22
    38
    66
    Roma
    84
    61
    37
    04
    73
    Torino
    31
    27
    16
    64
    38
    Venezia
    45
    18
    13
    75
    82
    Nazionale
    52
    82
    57
    61
    07
    Estrazione Simbolotto
    Torino
    07
    26
    35
    45
    40
Alto