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 >PLATINUM<
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

Con scelta ruote e numeri (modifica chiesta da Serpico 90)

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,AA
   Dim Dist2B,Dist3B,Dist4B,Dist5B,BB
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),A2(5),B1(5),B2(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9830)
   R1 = InputBox("Inserisci Il Numero Della Prima Ruota",Salvo50,3)
   AA = CInt(InputBox("Inserisci Il Numero Dell'Estratto Della Prima Ruota",Salvo50,2))
   R2 = InputBox("Inserisci Il Numero Della seconda Ruota",Salvo50,10)
   If R1 <> R2 Then
      BB = CInt(InputBox("Inserisci Il Numero Dell'Estratto Della Seconda Ruota",Salvo50,47))
      If BB = Diametrale(AA) Then
         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
         Scrivi Space(8) & "CON SCELTA RUOTE E NUMERI modifica chiesta da Serpico 90",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 P1 = 1 To 5
               A = Estratto(Es,R1,P1)
               If A = AA Then
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B = BB Then
                        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
                  Next
               End If
            Next
            If ScriptInterrotto Then Exit Sub
         Next
         ScriviResoconto
      End If
      If AA <> Diametrale(BB) Then Scrivi " I NUMERI INSERITI NON SONO DIAMETRALI",1,,,2
   End If
   If R1 = R2 Then Scrivi " HAI INSERITO 2 RUOTE UGUALI",1,,,2
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

Unica condizione diametralità estratti scelti

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,AA
   Dim Dist2B,Dist3B,Dist4B,Dist5B,BB
   Dim XA,XB,UgA,UgB,k1,K2,Nu1,Nu2,Nu3,Nu4
   Dim A1(5),A2(5),B1(5),B2(5),Qua(4),Ruo(2),Posta(4)
   Sp = " "
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9730)
   R1 = InputBox("Inserisci Il Numero Della Prima Ruota",Salvo50,4)
   AA = CInt(InputBox("Inserisci Il Numero Dell'Estratto Della Prima Ruota",Salvo50,16))
   R2 = InputBox("Inserisci Il Numero Della seconda Ruota",Salvo50,9)
   If R1 <> R2 Then
      BB = CInt(InputBox("Inserisci Il Numero Dell'Estratto Della Seconda Ruota",Salvo50,61))
      If BB = Diametrale(AA) Then
         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
         Scrivi Space(8) & "CON SCELTA RUOTE E NUMERI modifica chiesta da Serpico 90 ",1,,4,,3,,1
         Scrivi Space(8) & "CON UNICA CONDIZIONE DIAMETRALITA' ESTRATTI SCELTI       ",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 P1 = 1 To 5
               A = Estratto(Es,R1,P1)
               If A = AA Then
                  For P2 = 1 To 5
                     B = Estratto(Es,R2,P2)
                     If B = BB Then
                        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 'PER CONTROLLO DISTANZA UGUALE
                        Nu1 = 0 : Nu2 = 0 : Nu3 = 0 : Nu4 = 0
                        'If XB <> Diametrale(XA) Then ' PER CONTROLLO DIAMETRALITA' COPPIE DISTANZE UGUALI
                        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(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 ' PER CONTROLLO DIAMETRALITA' COPPIE DISTANZE UGUALI
                        'End If 'PER CONTROLLO DISTANZA UGUALE
                     End If
                  Next
               End If
            Next
            If ScriptInterrotto Then Exit Sub
         Next
         ScriviResoconto
      End If
      If AA <> Diametrale(BB) Then Scrivi " I NUMERI INSERITI NON SONO DIAMETRALI",1,,,2
   End If
   If R1 = R2 Then Scrivi " HAI INSERITO 2 RUOTE UGUALI",1,,,2
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 >PLATINUM<
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...
 

Franco2761

Junior Member
Ciao a tutti, un grazie a tutti, voglio farvi un bel regalo in allegato un bellissimo metodo, sperando che il nostro amico Salvo50 vuole onorarci facendo lo script. Un saluto a tutti
Franco Mongillo
 

Allegati

  • IL QUADRATO DIAMETRALE 1.pdf
    486,8 KB · Visite: 61

salvo50

Advanced Member >PLATINUM PLUS<
Ciao a tutti, un grazie a tutti, voglio farvi un bel regalo in allegato un bellissimo metodo, sperando che il nostro amico Salvo50 vuole onorarci facendo lo script. Un saluto a tutti
Franco Mongillo
Alien, Franco2761, Giovanni81, Matematico, Rudivall, Serpico90, Xeroxs
Grazie!

Ciao a Tutti.

IL QUADRATO DIAMETRALE di FRANCO MONGILLO

Dei 2 metodi richiesti, per primo ho fatto il secondo, IL QUADRATO DIAMETRALE perchè lo vedo più semplice, finito e lanciato mi sono accorto che le 2 somme uguali non sempre erano in verticale, a volte erano in orizzontale, e quando erano in orizzontale, negli abbinamenti per ambo c'erano dei doppioni, quindi quando la somma uguale era in orizzontale ho eliminato l'ambo doppio, però non mi piaceva come soluzione, quindi l'ho modificato un po' e ne ho fatto un'altro che sfrutta tutti e due le somme, cioè quando le 2 somme uguali sono orizzontali gli abbinamenti sono ricavati dalle somme diagonali e verticali, invece quando le 2 somme uguali sono in verticale segue il metodo esposto, gli abbinamenti sono ricavati dalle somme orizzontali e diagonali

In data 28-11-20, ho aggiunto un terzo script "Ambi Isotopi e Ruote Consecutive"

script 1 con eliminazione eventuale ambo doppio

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp1,Clp2,Clp3,R1,R2,Caso
   Dim P1,P2,P3,P4,P,PP,E1,E2,A,B,C,D,Casi
   Dim DAB,DCD,Somma1,Somma2,Somma3,Amb,G,X
   Dim DiSoOr1,DiSoOr2,DiSoDi1,DiSoDi2,Salvo50
   Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2
   Dim Amba(1),Ambo(2),M(4),Penta(5),Num(4)
   Dim Ruote(2),Ruots(1),Posta(1),Poste(2),Post(5)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9840)'9675
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,8)
   Clp2 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,8)
   Clp3 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "IL QUADRATO DIAMETRALE 1 di FRANCO MONGILLO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   'Post(2) = 1
   Post(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      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)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        DAB = Distanza(A,B) : DCD = Distanza(C,D)
                        If DAB = DCD Then
                           M(1) = A : M(2) = B : M(3) = C : M(4) = D
                           Call OrdinaMatrice(M,1)
                           'M1--M2
                           '|    |
                           'M4--M3
                           SomOr1 = Fuori90(M(1) + M(2)) : SomOr2 = Fuori90(M(3) + M(4))
                           SomDi1 = Fuori90(M(1) + M(3)) : SomDi2 = Fuori90(M(2) + M(4))
                           SomVe1 = Fuori90(M(1) + M(4)) : SomVe2 = Fuori90(M(2) + M(3))
                           Somma1 = Fuori90(SomOr1 + SomOr2)
                           Somma2 = Fuori90(SomDi1 + SomDi2)
                           Somma3 = Fuori90(SomVe1 + SomVe2)
                           Amb = ComplAdX(Somma1)
                           DiSoOr1 = Diametrale(SomOr1) : DiSoOr2 = Diametrale(SomOr2)
                           DiSoDi1 = Diametrale(SomDi1) : DiSoDi2 = Diametrale(SomDi2)
                           Num(1) = DiSoOr1 : Num(2) = DiSoOr2 : Num(3) = DiSoDi1 : Num(4) = DiSoOr2
                           Amba(1) = Amb
                           Penta(1) = Amb : Penta(2) = DiSoOr1 : Penta(3) = DiSoOr2 : Penta(4) = DiSoDi1 : Penta(5) = DiSoDi2
                           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(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R1) & " ",1,0
                           For P = 1 To 5
                              E1 = Estratto(Es,R1,P)
                              If E1 = A Or E1 = B Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E1) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DAB),1,,,1
                           Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R2) & " ",1,0
                           For PP = 1 To 5
                              E2 = Estratto(Es,R2,PP)
                              If E2 = C Or E2 = D Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E2) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DCD),1,,,1
                           Scrivi
                           Scrivi Space(4) & "Estr. Ordine" & Space(14) & "Somme " & Space(9),1,0
                           Scrivi "  Somme" & Space(9) & " Somme",1
                           Scrivi Space(4) & "Ciclometrico " & Space(10) & " Orizontali" & Space(7),1,0
                           Scrivi "Diagonali      Verticali",1
                           Scrivi Space(7) & Format2(M(1)) & " " & Format2(M(2)) & Space(20),1,0
                           Scrivi Format2(SomOr1) & Space(14) & Format2(SomDi1),1,0
                           Scrivi Space(14) & Format2(SomVe1),1
                           Scrivi Space(7) & Format2(M(4)) & " " & Format2(M(3)) & Space(20),1,0
                           Scrivi Format2(SomOr2) & Space(14) & Format2(SomDi2),1,0
                           Scrivi Space(14) & Format2(SomVe2),1
                           Scrivi Space(32) & String(34,"-"),1
                           Scrivi Space(6) & "Triplo Sommativo --> " & Space(5) & Format2(Somma1) & Space(14),1,0
                           Scrivi Format2(Somma2) & Space(14) & Format2(Somma3),1
                           Scrivi
                           Scrivi Space(10) & "Complemento a 90 del Triplo Sommativo " & Format2(Somma1),1,0
                           Scrivi " = " & Format2(Amb) & " Ambata",1
                           Scrivi
                           Scrivi Space(20) & " Abbinamenti per Ambo" & Space(20) & " Ambi Secchi",1,,,2
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOr1) & " = " & "Abbinamento1 " & Format2(DiSoOr1),1,0
                           Scrivi Space(14) & "Ambo1 " & Format2(Amb) & " " & Format2(DiSoOr1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOr2) & " = " & "Abbinamento2 " & Format2(DiSoOr2),1,0
                           Scrivi Space(14) & "Ambo2 " & Format2(Amb) & " " & Format2(DiSoOr2),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi1) & " = " & "Abbinamento3 " & Format2(DiSoDi1),1,0
                           Scrivi Space(14) & "Ambo3 " & Format2(Amb) & " " & Format2(DiSoDi1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi2) & " = " & "Abbinamento4 " & Format2(DiSoDi2),1,0
                           Scrivi Space(14) & "Ambo4 " & Format2(Amb) & " " & Format2(DiSoDi2),1
                           Scrivi
                           Scrivi Space(24) & " Cinquina " & StringaNumeri(Penta," ",True),1,,,1
                           Scrivi
                           Ruote(1) = R1
                           Ruote(2) = R2
                           Ruots(1) = TU_
                           EliminaRipetuti Num
                           G = 1
                           ImpostaGiocata G,Amba,Ruote,Posta,Clp1,1
                           For X = 1 To UBound(Num)
                              If Amba(1) <> Num(X)Then
                                 Ambo(1) = Amba(1): Ambo(2) = Num(X)
                                 If Ambo(2) > 0 Then
                                    G = G + 1
                                    ImpostaGiocata G,Ambo,Ruote,Poste,Clp2,2
                                 End If
                              End If
                           Next
                           G = G + 1
                           EliminaRipetuti Penta
                           ImpostaGiocata G,Penta,Ruots,Post,Clp3
                           Gioca Es,1,,1
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub


script 2

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp1,Clp2,Clp3,R1,R2,Caso
   Dim P1,P2,P3,P4,P,PP,E1,E2,A,B,C,D,Casi
   Dim DAB,DCD,Somma1,Somma2,Somma3,Amb,G,X
   Dim DiSoDi1,DiSoDi2,Salvo50
   Dim DiFOrVe1,DiFOrVe2,SomOrVe1,SomOrVe2
   Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2
   Dim Amba(1),Ambo(2),M(4),Penta(5),Num(4)
   Dim Ruote(2),Ruots(1),Posta(1),Poste(2),Post(5)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9840)'9675
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,8)
   Clp2 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,8)
   Clp3 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "IL QUADRATO DIAMETRALE 2 di FRANCO MONGILLO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   'Post(2) = 1
   Post(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      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)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        C = Estratto(Es,R2,P3)
                        D = Estratto(Es,R2,P4)
                        DAB = Distanza(A,B) : DCD = Distanza(C,D)
                        If DAB = DCD Then
                           M(1) = A : M(2) = B : M(3) = C : M(4) = D
                           Call OrdinaMatrice(M,1)
                           'M1--M2
                           '|    |
                           'M4--M3
                           SomOr1 = Fuori90(M(1) + M(2)) : SomOr2 = Fuori90(M(3) + M(4))
                           SomDi1 = Fuori90(M(1) + M(3)) : SomDi2 = Fuori90(M(2) + M(4))
                           SomVe1 = Fuori90(M(1) + M(4)) : SomVe2 = Fuori90(M(2) + M(3))
                           Somma1 = Fuori90(SomOr1 + SomOr2)
                           Somma2 = Fuori90(SomDi1 + SomDi2)
                           Somma3 = Fuori90(SomVe1 + SomVe2)
                           Amb = ComplAdX(Somma1)
                           If SomOr1 <> SomOr2 Then
                              DiFOrVe1 = Diametrale(SomOr1) : DiFOrVe2 = Diametrale(SomOr2)
                              SomOrVe1 = SomOr1
                              SomOrVe2 = SomOr2
                           End If
                           If SomVe1 <> SomVe2 Then
                              DiFOrVe1 = Diametrale(SomVe1) : DiFOrVe2 = Diametrale(SomVe2)
                              SomOrVe1 = SomVe1
                              SomOrVe2 = SomVe2
                           End If
                           DiSoDi1 = Diametrale(SomDi1) : DiSoDi2 = Diametrale(SomDi2)
                           Num(1) = DiFOrVe1 : Num(2) = DiFOrVe2 : Num(3) = DiSoDi1 : Num(4) = DiFOrVe2
                           Amba(1) = Amb
                           Penta(1) = Amb : Penta(2) = DiFOrVe1 : Penta(3) = DiFOrVe2 : Penta(4) = DiSoDi1 : Penta(5) = DiSoDi2
                           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(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R1) & " ",1,0
                           For P = 1 To 5
                              E1 = Estratto(Es,R1,P)
                              If E1 = A Or E1 = B Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E1) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DAB),1,,,1
                           Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                           Scrivi "  " & SiglaRuota(R2) & " ",1,0
                           For PP = 1 To 5
                              E2 = Estratto(Es,R2,PP)
                              If E2 = C Or E2 = D Then
                                 ColoreTesto 2
                              Else
                                 ColoreTesto 0
                              End If
                              Scrivi Format2(E2) & " ",1,0
                              ColoreTesto 0
                           Next
                           Scrivi "  <-- Evidenziati con Distanza " & Format2(DCD),1,,,1
                           Scrivi
                           Scrivi Space(4) & "Estr. Ordine" & Space(14) & "Somme " & Space(9),1,0
                           Scrivi "  Somme" & Space(9) & " Somme",1
                           Scrivi Space(4) & "Ciclometrico " & Space(10) & " Orizontali" & Space(7),1,0
                           Scrivi "Diagonali      Verticali",1
                           Scrivi Space(7) & Format2(M(1)) & " " & Format2(M(2)) & Space(20),1,0
                           Scrivi Format2(SomOr1) & Space(14) & Format2(SomDi1),1,0
                           Scrivi Space(14) & Format2(SomVe1),1
                           Scrivi Space(7) & Format2(M(4)) & " " & Format2(M(3)) & Space(20),1,0
                           Scrivi Format2(SomOr2) & Space(14) & Format2(SomDi2),1,0
                           Scrivi Space(14) & Format2(SomVe2),1
                           Scrivi Space(32) & String(34,"-"),1
                           Scrivi Space(6) & "Triplo Sommativo --> " & Space(5) & Format2(Somma1) & Space(14),1,0
                           Scrivi Format2(Somma2) & Space(14) & Format2(Somma3),1
                           Scrivi
                           Scrivi Space(10) & "Complemento a 90 del Triplo Sommativo " & Format2(Somma1),1,0
                           Scrivi " = " & Format2(Amb) & " Ambata",1
                           Scrivi
                           Scrivi Space(20) & " Abbinamenti per Ambo" & Space(20) & " Ambi Secchi",1,,,2
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe1) & " = " & "Abbinamento1 " & Format2(DiFOrVe1),1,0
                           Scrivi Space(14) & "Ambo1 " & Format2(Amb) & " " & Format2(DiFOrVe1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe2) & " = " & "Abbinamento2 " & Format2(DiFOrVe2),1,0
                           Scrivi Space(14) & "Ambo2 " & Format2(Amb) & " " & Format2(DiFOrVe2),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi1) & " = " & "Abbinamento3 " & Format2(DiSoDi1),1,0
                           Scrivi Space(14) & "Ambo3 " & Format2(Amb) & " " & Format2(DiSoDi1),1
                           Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi2) & " = " & "Abbinamento4 " & Format2(DiSoDi2),1,0
                           Scrivi Space(14) & "Ambo4 " & Format2(Amb) & " " & Format2(DiSoDi2),1
                           Scrivi
                           Scrivi Space(24) & " Cinquina " & StringaNumeri(Penta," ",True),1,,,1
                           Scrivi
                           Ruote(1) = R1
                           Ruote(2) = R2
                           Ruots(1) = TU_
                           EliminaRipetuti Num
                           G = 1
                           ImpostaGiocata G,Amba,Ruote,Posta,Clp1,1
                           For X = 1 To UBound(Num)
                              If Amba(1) <> Num(X)Then
                                 Ambo(1) = Amba(1): Ambo(2) = Num(X)
                                 If Ambo(2) > 0 Then
                                    G = G + 1
                                    ImpostaGiocata G,Ambo,Ruote,Poste,Clp2,2
                                 End If
                              End If
                           Next
                           G = G + 1
                           EliminaRipetuti Penta
                           ImpostaGiocata G,Penta,Ruots,Post,Clp3
                           Gioca Es,1,,1
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub


Ambi Isotopi e Ruote Consecutive

Codice:
Option Explicit
Sub Main
   Dim FIn,Es,Ini,Clp1,Clp2,Clp3,R1,R2,Caso
   Dim P1,P2,P3,P4,P,PP,E1,E2,A,B,C,D,Casi
   Dim DAB,DCD,Somma1,Somma2,Somma3,Amb,G,X
   Dim DiSoDi1,DiSoDi2,Salvo50
   Dim DiFOrVe1,DiFOrVe2,SomOrVe1,SomOrVe2
   Dim SomOr1,SomOr2,SomVe1,SomVe2,SomDi1,SomDi2
   Dim Amba(1),Ambo(2),M(4),Penta(5),Num(4)
   Dim Ruote(2),Ruots(1),Posta(1),Poste(2),Post(5)
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9840)'9675
   Clp1 = InputBox("Per quanti colpi vuoi giocare l'Ambata?",,8)
   Clp2 = InputBox("Per quanti colpi vuoi giocare gli Ambi?",,8)
   Clp3 = InputBox("Per quanti colpi vuoi giocare la Cinquina?",,8)
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "IL QUADRATO DIAMETRALE 3 di FRANCO MONGILLO - SCRIPT SALVO50",1,,4,,3,,1
   Posta(1) = 1
   Poste(2) = 1
   'Post(2) = 1
   Post(3) = 1
   For Es = Ini To FIn
      Messaggio Es
      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 = 12
               C = Estratto(Es,R2,P1)
               D = Estratto(Es,R2,P2)
               DAB = Distanza(A,B) : DCD = Distanza(C,D)
               If DAB = DCD Then
                  M(1) = A : M(2) = B : M(3) = C : M(4) = D
                  Call OrdinaMatrice(M,1)
                  'M1--M2
                  '|    |
                  'M4--M3
                  SomOr1 = Fuori90(M(1) + M(2)) : SomOr2 = Fuori90(M(3) + M(4))
                  SomDi1 = Fuori90(M(1) + M(3)) : SomDi2 = Fuori90(M(2) + M(4))
                  SomVe1 = Fuori90(M(1) + M(4)) : SomVe2 = Fuori90(M(2) + M(3))
                  Somma1 = Fuori90(SomOr1 + SomOr2)
                  Somma2 = Fuori90(SomDi1 + SomDi2)
                  Somma3 = Fuori90(SomVe1 + SomVe2)
                  Amb = ComplAdX(Somma1)
                  If SomOr1 <> SomOr2 Then
                     DiFOrVe1 = Diametrale(SomOr1) : DiFOrVe2 = Diametrale(SomOr2)
                     SomOrVe1 = SomOr1
                     SomOrVe2 = SomOr2
                  End If
                  If SomVe1 <> SomVe2 Then
                     DiFOrVe1 = Diametrale(SomVe1) : DiFOrVe2 = Diametrale(SomVe2)
                     SomOrVe1 = SomVe1
                     SomOrVe2 = SomVe2
                  End If
                  DiSoDi1 = Diametrale(SomDi1) : DiSoDi2 = Diametrale(SomDi2)
                  Num(1) = DiFOrVe1 : Num(2) = DiFOrVe2 : Num(3) = DiSoDi1 : Num(4) = DiFOrVe2
                  Amba(1) = Amb
                  Penta(1) = Amb : Penta(2) = DiFOrVe1 : Penta(3) = DiFOrVe2 : Penta(4) = DiSoDi1 : Penta(5) = DiSoDi2
                  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(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi "  " & SiglaRuota(R1) & " ",1,0
                  For P = 1 To 5
                     E1 = Estratto(Es,R1,P)
                     If E1 = A Or E1 = B Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E1) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi "  <-- Evidenziati con Distanza " & Format2(DAB),1,,,1
                  Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                  Scrivi "  " & SiglaRuota(R2) & " ",1,0
                  For PP = 1 To 5
                     E2 = Estratto(Es,R2,PP)
                     If E2 = C Or E2 = D Then
                        ColoreTesto 2
                     Else
                        ColoreTesto 0
                     End If
                     Scrivi Format2(E2) & " ",1,0
                     ColoreTesto 0
                  Next
                  Scrivi "  <-- Evidenziati con Distanza " & Format2(DCD),1,,,1
                  Scrivi
                  Scrivi Space(4) & "Estr. Ordine" & Space(14) & "Somme " & Space(9),1,0
                  Scrivi "  Somme" & Space(9) & " Somme",1
                  Scrivi Space(4) & "Ciclometrico " & Space(10) & " Orizontali" & Space(7),1,0
                  Scrivi "Diagonali      Verticali",1
                  Scrivi Space(7) & Format2(M(1)) & " " & Format2(M(2)) & Space(20),1,0
                  Scrivi Format2(SomOr1) & Space(14) & Format2(SomDi1),1,0
                  Scrivi Space(14) & Format2(SomVe1),1
                  Scrivi Space(7) & Format2(M(4)) & " " & Format2(M(3)) & Space(20),1,0
                  Scrivi Format2(SomOr2) & Space(14) & Format2(SomDi2),1,0
                  Scrivi Space(14) & Format2(SomVe2),1
                  Scrivi Space(32) & String(34,"-"),1
                  Scrivi Space(6) & "Triplo Sommativo --> " & Space(5) & Format2(Somma1) & Space(14),1,0
                  Scrivi Format2(Somma2) & Space(14) & Format2(Somma3),1
                  Scrivi
                  Scrivi Space(10) & "Complemento a 90 del Triplo Sommativo " & Format2(Somma1),1,0
                  Scrivi " = " & Format2(Amb) & " Ambata",1
                  Scrivi
                  Scrivi Space(20) & " Abbinamenti per Ambo" & Space(20) & " Ambi Secchi",1,,,2
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe1) & " = " & "Abbinamento1 " & Format2(DiFOrVe1),1,0
                  Scrivi Space(14) & "Ambo1 " & Format2(Amb) & " " & Format2(DiFOrVe1),1
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomOrVe2) & " = " & "Abbinamento2 " & Format2(DiFOrVe2),1,0
                  Scrivi Space(14) & "Ambo2 " & Format2(Amb) & " " & Format2(DiFOrVe2),1
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi1) & " = " & "Abbinamento3 " & Format2(DiSoDi1),1,0
                  Scrivi Space(14) & "Ambo3 " & Format2(Amb) & " " & Format2(DiSoDi1),1
                  Scrivi Space(10) & " Il Diametrale di " & Format2(SomDi2) & " = " & "Abbinamento4 " & Format2(DiSoDi2),1,0
                  Scrivi Space(14) & "Ambo4 " & Format2(Amb) & " " & Format2(DiSoDi2),1
                  Scrivi
                  Scrivi Space(24) & " Cinquina " & StringaNumeri(Penta," ",True),1,,,1
                  Scrivi
                  Ruote(1) = R1
                  Ruote(2) = R2
                  Ruots(1) = TU_
                  EliminaRipetuti Num
                  G = 1
                  ImpostaGiocata G,Amba,Ruote,Posta,Clp1,1
                  For X = 1 To UBound(Num)
                     If Amba(1) <> Num(X)Then
                        Ambo(1) = Amba(1): Ambo(2) = Num(X)
                        If Ambo(2) > 0 Then
                           G = G + 1
                           ImpostaGiocata G,Ambo,Ruote,Poste,Clp2,2
                        End If
                     End If
                  Next
                  G = G + 1
                  EliminaRipetuti Penta
                  ImpostaGiocata G,Penta,Ruots,Post,Clp3
                  Gioca Es,1,,1
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
 
Ultima modifica:

Franco2761

Junior Member
Grazie Salvo50 BRAVISSIMO come sempre dovremmo farci una modifica prendere solo le previsioni dove gli ambi di ricerca devono essere isotopi e le ruote consecutive. Puoi mandarmi la tua email? grazie
Franco Mongillo
 
Ultima modifica:

Matematico

Advanced Member >PLATINUM<
Grazie Salvo50 BRAVISSIMO come sempre dovremmo farci una modifica prendere solo le previsioni dove gli ambi di ricerca devono essere isotopi e le ruote consecutive. Puoi mandarmi la tua email? grazie
Franco Mongillo
Ciao Franco2761 , purtroppo in questo forum non è possibile mettere email personali , ci avevo provato anch'io ma mi è stato vietato :-(
 

salvo50

Advanced Member >PLATINUM PLUS<
Bravissimo pare che ora vada meglio, ascolta volevo solo chiederti se si poteva fare uno script per una ricerca estrazionale tutto lì. Un grazie e un salutone.
Franco
Ciao Franco, se per ricerca estrazionale intendi statistica, ritardi, frequenze, non ci capisco niente, e non ho tempo e voglia di impararli.
 

Franco2761

Junior Member
No no è una ricerca estrazionale in pratica bisogna cercare su due ruote anche non consecutive in posizione isotopa due ambi di uguale somma col fuori 90 ovviamente, poi nell'estrazione dietro massimo 2 estrazioni magari poter inserire quante estrazioni dietro andare) nella stessa posizione e sulle stesse ruote altri due ambi di somma uguale ma diversa da quella dei due ambi dell'altra però ci devono essere due numeri ripetuti uno nell'estrazione primaria e l'altro nell'estrazione a ritroso, tutto qua.
Faccio un esempio
Cagliari 76 - 61 2* e 3* posizione
Firenze 43 - 4 2* e 3* posizione

nell'estrazione precedente nella stessa posizione
Cagliari 37 - 84 2* posizione e 3* posizione
Firenze 4 - 27 2* posizione e 3* posizione

Un salutone
Franco
 

salvo50

Advanced Member >PLATINUM PLUS<
Ciao a Tutti.

Blacklotto, faranco2761, Rudivall, Serpico90, Xeroxs

Grazie!

AMBO QUADRUPLO E ISOTOPO - FRANCO MONGILLO

Codice:
Option Explicit
Sub Main
   Dim FIn,Es1,Es2,Ini,Caso,Casi,Salvo50
   Dim A,B,C,D,AA,BB,CC,DD,E1,E2,E3,E4
   Dim R1,R2,P1,P2,P3,P4,P5,P6
   Dim SomAB,SomCD,SomAABB,SomCCDD,Ind
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9700)
   Ind = CInt(InputBox("Quante Estrazioni Indietro, Vuoi Andare per il Controllo?",,5))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "AMBO QUADRUPLO E ISOTOPO - FRANCO MONGILLO  - SCRIPT SALVO50",1,,4,,3,,1
   For Es1 = Ini To FIn
      Messaggio Es1
      AvanzamentoElab Ini,FIn,Es1
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            For P2 = P1 + 1 To 5
               A = Estratto(Es1,R1,P1)
               B = Estratto(Es1,R1,P2)
               SomAB = Fuori90(A + B)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  C = Estratto(Es1,R2,P1)
                  D = Estratto(Es1,R2,P2)
                  SomCD = Fuori90(C + D)
                  If A <> C And A <> D And B <> C And B <> D Then
                     If SomCD = SomAB Then
                        For Es2 = Es1 - 1 To Es1 - Ind Step - 1
                           AA = Estratto(Es2,R1,P1)
                           BB = Estratto(Es2,R1,P2)
                           CC = Estratto(Es2,R2,P1)
                           DD = Estratto(Es2,R2,P2)
                           SomAABB = Fuori90(AA + BB) : SomCCDD = Fuori90(CC + DD)
                           If SomAABB = SomCCDD Then
                            
If A = AA Or A = BB Or B = AA Or B = BB Or C = CC Or C = DD Or D = CC Or D = DD Then

                                 'A--B
                                 '|  |
                                 'C--D
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 ColoreTesto 2
                                 Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                 ColoreTesto 1
                                 Scrivi String(80,"*") & " Estrazione " &(Es1) & " caso " & FormattaStringa(Caso,"0000")
                                 ColoreTesto 0
                                 Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & " ",1,0
                                 For P3 = 1 To 5
                                    E1 = Estratto(Es1,R1,P3)
                                    If E1 = A Or E1 = B Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E1) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomAB),1
                                 Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                 For P4 = 1 To 5
                                    E2 = Estratto(Es1,R2,P4)
                                    If E2 = C Or E2 = D Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomCD),1
                                 Scrivi
                                 Scrivi Space(15) & " Scelto di Andare a Ritroso di Massimo " & Ind & " Eestrazioni",1,,,1
                                 Scrivi
                                 Scrivi(" Estrazione n." & Format2(Es2) & " del " & DataEstrazione(Es2)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & " ",1,0
                                 For P5 = 1 To 5
                                    E3 = Estratto(Es2,R1,P5)
                                    If E3 = AA Or E3 = BB Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E3) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomAABB),1
                                 Scrivi(" Estrazione n." & Format2(Es2) & " del " & DataEstrazione(Es2)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                 For P6 = 1 To 5
                                    E4 = Estratto(Es2,R2,P6)
                                    If E4 = CC Or E4 = DD Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E4) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomCCDD),1
                              End If
                           End If
                        Next
                     End If
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   Scrivi
   Scrivi " Tempo trascorso " & TempoTrascorso
End Sub
 
Ultima modifica:

Franco2761

Junior Member
Ciao a Tutti.

Blacklotto, faranco2761, Rudivall, Serpico90, Xeroxs

Grazie!

AMBO QUADRUPLO E ISOTOPO - FRANCO MONGILLO

Codice:
Option Explicit
Sub Main
   Dim FIn,Es1,Es2,Ini,Caso,Casi,Salvo50
   Dim A,B,C,D,AA,BB,CC,DD,E1,E2,E3,E4
   Dim R1,R2,P1,P2,P3,P4,P5,P6
   Dim SomAB,SomCD,SomAABB,SomCCDD,Ind
   FIn = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9700)
   Ind = CInt(InputBox("Quante Estrazioni Indietro, Vuoi Andare per il Controllo?",,5))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(8) & "AMBO QUADRUPLO E ISOTOPO - FRANCO MONGILLO  - SCRIPT SALVO50",1,,4,,3,,1
   For Es1 = Ini To FIn
      Messaggio Es1
      AvanzamentoElab Ini,FIn,Es1
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 5
            For P2 = P1 + 1 To 5
               A = Estratto(Es1,R1,P1)
               B = Estratto(Es1,R1,P2)
               SomAB = Fuori90(A + B)
               For R2 = R1 + 1 To 12
                  If R2 = 11 Then R2 = 12
                  C = Estratto(Es1,R2,P1)
                  D = Estratto(Es1,R2,P2)
                  SomCD = Fuori90(C + D)
                  If A <> C And A <> D And B <> C And B <> D Then
                     If SomCD = SomAB Then
                        For Es2 = Es1 - 1 To Es1 - Ind Step - 1
                           AA = Estratto(Es2,R1,P1)
                           BB = Estratto(Es2,R1,P2)
                           CC = Estratto(Es2,R2,P1)
                           DD = Estratto(Es2,R2,P2)
                           SomAABB = Fuori90(AA + BB) : SomCCDD = Fuori90(CC + DD)
                           If SomAABB = SomCCDD Then
                           
If A = AA Or A = BB Or B = AA Or B = BB Or C = CC Or C = DD Or D = CC Or D = DD Then

                                 'A--B
                                 '|  |
                                 'C--D
                                 Caso = Caso + 1
                                 Casi = Casi + 1
                                 ColoreTesto 2
                                 Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000")
                                 ColoreTesto 1
                                 Scrivi String(80,"*") & " Estrazione " &(Es1) & " caso " & FormattaStringa(Caso,"0000")
                                 ColoreTesto 0
                                 Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & " ",1,0
                                 For P3 = 1 To 5
                                    E1 = Estratto(Es1,R1,P3)
                                    If E1 = A Or E1 = B Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E1) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomAB),1
                                 Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                 For P4 = 1 To 5
                                    E2 = Estratto(Es1,R2,P4)
                                    If E2 = C Or E2 = D Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E2) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomCD),1
                                 Scrivi
                                 Scrivi Space(15) & " Scelto di Andare a Ritroso di Massimo " & Ind & " Eestrazioni",1,,,1
                                 Scrivi
                                 Scrivi(" Estrazione n." & Format2(Es2) & " del " & DataEstrazione(Es2)),1,0
                                 Scrivi "  " & SiglaRuota(R1) & " ",1,0
                                 For P5 = 1 To 5
                                    E3 = Estratto(Es2,R1,P5)
                                    If E3 = AA Or E3 = BB Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E3) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomAABB),1
                                 Scrivi(" Estrazione n." & Format2(Es2) & " del " & DataEstrazione(Es2)),1,0
                                 Scrivi "  " & SiglaRuota(R2) & " ",1,0
                                 For P6 = 1 To 5
                                    E4 = Estratto(Es2,R2,P6)
                                    If E4 = CC Or E4 = DD Then
                                       ColoreTesto 2
                                    Else
                                       ColoreTesto 0
                                    End If
                                    Scrivi Format2(E4) & " ",1,0
                                    ColoreTesto 0
                                 Next
                                 Scrivi " <-- Somma Evidenziati = " & Format2(SomCCDD),1
                              End If
                           End If
                        Next
                     End If
                  End If
               Next
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   Scrivi
   Scrivi " Tempo trascorso " & TempoTrascorso
End Sub
Ciao Salvo50 innanzitutto grazie e come sempre sei bravissimo e preciso....sto lavorando su queste formazioni poi vi informerò sugli sviluppi per centrare la vincita. Un salutone
Franco
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 26 marzo 2024
    Bari
    30
    51
    17
    01
    53
    Cagliari
    13
    70
    25
    68
    47
    Firenze
    28
    30
    54
    70
    88
    Genova
    67
    87
    22
    03
    62
    Milano
    22
    34
    13
    47
    24
    Napoli
    20
    72
    59
    01
    52
    Palermo
    05
    72
    65
    52
    32
    Roma
    28
    43
    75
    54
    87
    Torino
    16
    08
    17
    24
    38
    Venezia
    67
    28
    55
    60
    29
    Nazionale
    15
    69
    22
    63
    39
    Estrazione Simbolotto
    Firenze
    44
    09
    31
    22
    16

Ultimi Messaggi

Alto