Novità

X 1 LISTATO CICLOMETRICO

tiberio1

tiberio1

Member
APPELLO AGLI AMICI DEL FORUM CERCASI LISTATO RILEVANDO SU 2 RUOTE LA PRESENZA DI ELEMENTI DELLA STESSA CADENZA POI DISPORRE IN ORDINE CICLOMETRICO I VALORI RINTRACCIATI AD ESEMPIO 55 65 DIST 10 -? - DIST 10 - 85 DIST 10 -? --- DIST 10 15

INSERIRE ELEMENTI MANCANTI OSSIA IL 5 E IL 75 CHE FUNGERANNO DA CAPOGIOCO ABBINATI A 55 -65-- 85 . IL 5 CAPOGIOCO SEPARATO CON 55 65 E 85 E IL 75 SEPARATO CON 55 65 85
 
Ciao Tiberio1, questa spiegazione per me è incomprensibile, mi sembra un codice segreto:)
potresti spiegarlo meglio con più dettagli, magari invece di usare spazio scrivi su più righe

10 -? - DIST 10 - 85 DIST 10 -? --- DIST 10 15
 
tiberio1 ha scritto:
APPELLO AGLI AMICI DEL FORUM CERCASI LISTATO RILEVANDO SU 2 RUOTE LA PRESENZA DI ELEMENTI DELLA STESSA CADENZA POI DISPORRE IN ORDINE CICLOMETRICO I VALORI RINTRACCIATI AD ESEMPIO 55 65 DIST 10 -? - DIST 10 - 85 DIST 10 -? --- DIST 10 15

INSERIRE ELEMENTI MANCANTI OSSIA IL 5 E IL 75 CHE FUNGERANNO DA CAPOGIOCO ABBINATI A 55 -65-- 85 . IL 5 CAPOGIOCO SEPARATO CON 55 65 E 85 E IL 75 SEPARATO CON 55 65 85
Clicca per espandere...

salvo50 ha scritto:
Ciao Tiberio1, questa spiegazione per me è incomprensibile, mi sembra un codice segreto:)
potresti spiegarlo meglio con più dettagli, magari invece di usare spazio scrivi su più righe

10 -? - DIST 10 - 85 DIST 10 -? --- DIST 10 15
Clicca per espandere...
 

Allegati

  • Snapshot_21-02-09_11-34-31.png
    Snapshot_21-02-09_11-34-31.png
    253,6 KB · Visite: 44
Ciao a Tutti

L'Esempio nell'articolo è del 08-03-2007 estrazione 7722

Codice: 
Option Explicit
Dim FIn,Ini,A,B,C,D,A1,B1,C1,D1,Clp,Es1
Dim R1,R2,P1,P2,P3,P4,P5,P6,E1,E2,Caso,Casi
Dim CadA,CadB,CadC,CadD,Ok,k,k1,Salvo50,G,X
Dim DiM12,DiM23,DiM34,Dim41,Amba1,Amba2,k2
Dim Ambata(1),Ambo1(2),Ambo(2),Num(6)
Dim Ruo(2),Posta(2),H(6),M(4),Nm(2)
Sub Main
   FIn = EstrazioneFin
   Ini = CInt(InputBox("Inserisci l'estrazione che vuoi iniziare",Salvo50,9850))
   Clp = CInt(InputBox(" Per quanti colpi vuoi giocare?",Salvo50,7))
   Call ScegliRange(Ini,FIn,Ini,FIn)
   Scrivi Space(12) & "Chiesto da Tiberio1 - 2 Ambi, 2 Ruote, Sequenza 10   - Script Salvo50",1,,4,,3,,1
   Posta(2) = 1
   For Es1 = Ini To FIn
      Messaggio Es1
      AvanzamentoElab Ini,FIn,Es1
      Caso = 0
      For R1 = 1 To 10
         For P1 = 1 To 4
            For P2 = P1 + 1 To 5
               A = Estratto(Es1,R1,P1)
               B = Estratto(Es1,R1,P2)
               CadA = Cadenza(A) : CadB = Cadenza(B)
               If A > 0 And CadA = CadB Then
                  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(Es1,R2,P3)
                           D = Estratto(Es1,R2,P4)
                           CadC = Cadenza(C) : CadD = Cadenza(D)
                           If C > 0 And CadC = CadD Then
                              'A---B
                              '|   |
                              'C---D
                              If A <> C And A <> D And B <> C And B <> D Then
                                 :
                                 If CadA = CadC Then
                                    Ok = 0
                                    For k = 1 To 6
                                       H(k) = 0
                                    Next
                                    M(1) = A : M(2) = B : M(3) = C : M(4) = D
                                    Call OrdinaMatrice(M,1)
                                    'PRIMO GRUPPO
                                    A1 = 0 : B1 = 0 : C1 = 0 : D1 = 0
                                    A1 = M(1) : B1 = M(2) : C1 = M(3) : D1 = M(4)
                                    DiM12 = Distanza(M(1),M(2)) :DiM23 = Distanza(M(2),M(3))
                                    DiM34 = Distanza(M(3),M(4)) :Dim41 = Distanza(M(4),M(1))
                                    Call Tiberio1
                                    'SECONDO GRUPPO
                                    A1 = 0 : B1 = 0 : C1 = 0 : D1 = 0
                                    A1 = M(2) : B1 = M(3) : C1 = M(4) : D1 = M(1)
                                    DiM12 = Distanza(M(2),M(3)) :DiM23 = Distanza(M(3),M(4))
                                    DiM34 = Distanza(M(4),M(1)) :Dim41 = Distanza(M(1),M(2))
                                    Call Tiberio1
                                    'TERZO GRUPPO
                                    A1 = 0 : B1 = 0 : C1 = 0 : D1 = 0
                                    A1 = M(3) : B1 = M(4) : C1 = M(1) : D1 = M(2)
                                    DiM12 = Distanza(M(3),M(4)) :DiM23 = Distanza(M(4),M(1))
                                    DiM34 = Distanza(M(1),M(2)) :Dim41 = Distanza(M(2),M(3))
                                    Call Tiberio1
                                    'QUARTO GRUPPO
                                    A1 = 0 : B1 = 0 : C1 = 0 : D1 = 0
                                    A1 = M(4) : B1 = M(1) : C1 = M(2) : D1 = M(3)
                                    DiM12 = Distanza(M(4),M(1)) :DiM23 = Distanza(M(1),M(2))
                                    DiM34 = Distanza(M(2),M(3)) :Dim41 = Distanza(M(3),M(4))
                                    Call Tiberio1
                                 End If
                              End If
                           End If
                        Next
                     Next
                  Next
               End If
            Next
         Next
      Next
      If ScriptInterrotto Then Exit Sub
   Next
   ScriviResoconto
End Sub
Function Tiberio1
   '1
   Ok = 0
   If(DiM12 = 10 And DiM23 = 10 And DiM34 = 20) Then
      Amba1 = Fuori90(C1 + 10) : Amba2 = Fuori90(D1 + 10)
      H(1) = A1 : H(2) = B1 : H(3) = C1 : H(4) = Amba1 : H(5) = D1 : H(6) = Amba2
      Ok = 1
   End If
   '2
   If(DiM12 = 10 And DiM23 = 20 And DiM34 = 10) Then
      Amba1 = Fuori90(B1 + 10) : Amba2 = Fuori90(D1 + 10)
      H(1) = A1 : H(2) = B1 : H(3) = Amba1 : H(4) = C1 : H(5) = D1 : H(6) = Amba2
      Ok = 1
   End If
   '3
   If(DiM12 = 10 And DiM23 = 20 And DiM34 = 20) Then
      Amba1 = Fuori90(B1 + 10) : Amba2 = Fuori90(C1 + 10)
      H(1) = A1 : H(2) = B1 : H(3) = Amba1 : H(4) = C1 : H(5) = Amba2 : H(6) = D1
      Ok = 1
   End If
   '4
   If(DiM12 = 20 And DiM23 = 10 And DiM34 = 10) Then
      Amba1 = Fuori90(A1 + 10) : Amba2 = Fuori90(D1 + 10)
      H(1) = A1 : H(2) = Amba1 : H(3) = B1 : H(4) = C1 : H(5) = D1 : H(6) = Amba2
      Ok = 1
   End If
   '5
   If(DiM12 = 20 And DiM23 = 10 And DiM34 = 20) Then
      Amba1 = Fuori90(A1 + 10) : Amba2 = Fuori90(C1 + 10)
      H(1) = A1 : H(2) = Amba1 : H(3) = B1 : H(4) = C1 : H(5) = Amba2 : H(6) = D1
      Ok = 1
   End If
   '6
   If(DiM12 = 20 And DiM23 = 20 And DiM34 = 10) Then
      Amba1 = Fuori90(A1 + 10) : Amba2 = Fuori90(B1 + 10)
      H(1) = A1 : H(2) = Amba1 : H(3) = B1 : H(4) = Amba2 : H(5) = C1 : H(6) = D1
      Ok = 1
   End If
   If Ok = 1 Then
      For k1 = 1 To 6
         Num(k1) = H(k1)
         If Num(k1) = A Or Num(k1) = B Or Num(k1) = C Or Num(k1) = D Then
            Num(k1) = 0
         End If
      Next
      Caso = Caso + 1
      Casi = Casi + 1
      Scrivi String(89,"*") & " Casi Totali " & FormattaStringa(Casi,"0000"),1,,,2
      Scrivi String(80,"*") & " Estrazione " &(Es1) & " caso " & FormattaStringa(Caso,"0000"),1,,,1
      Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
      Scrivi "  " & SiglaRuota(R1) & " ",1,0
      For P5 = 1 To 5
         E1 = Estratto(Es1,R1,P5)
         If E1 = A Or E1 = B Then
            ColoreTesto 2
         Else
            ColoreTesto 0
         End If
         Scrivi Format2(E1) & " ",1,0
         ColoreTesto 0
      Next
      Scrivi
      Scrivi(" Estrazione n." & Format2(Es1) & " del " & DataEstrazione(Es1)),1,0
      Scrivi "  " & SiglaRuota(R2) & " ",1,0
      For P6 = 1 To 5
         E2 = Estratto(Es1,R2,P6)
         If E2 = C Or E2 = D Then
            ColoreTesto 2
         Else
            ColoreTesto 0
         End If
         Scrivi Format2(E2) & " ",1,0
         ColoreTesto 0
      Next
      Scrivi
      Scrivi
      Scrivi Space(15) & "Sequenza " & Space(13) & " Elementi",1
      Scrivi Space(15) & "Completa " & Space(13) & " Mancanti",1
      Scrivi Space(10) & StringaNumeri(H," ",True) & Space(12) & StringaNumeri(Num," ",True),1
      Scrivi
      Dim I,MM
      For I = 1 To UBound(Num)
         If Num(I) > 0 Then
            MM = MM + 1
            'ReDim Preserve aN(MM)
            Nm(MM) = Num(I)
         End If
      Next
      Scrivi
      Ruo(1) = R1
      Ruo(2) = R2
      G = 1
      ImpostaGiocata G,Nm,Ruo,Posta,Clp,2
      For X = 1 To UBound(M)
         If Nm(1) <> M(X)Then
            Ambo(1) = Nm(1): Ambo(2) = M(X)
            If Ambo(2) > 0 Then
               G = G + 1
               ImpostaGiocata G,Ambo,Ruo,Posta,Clp,2
            End If
         End If
      Next
      For X = 1 To UBound(M)
         If Nm(2) <> M(X)Then
            Ambo(1) = Nm(2): Ambo(2) = M(X)
            If Ambo(2) > 0 Then
               G = G + 1
               ImpostaGiocata G,Ambo,Ruo,Posta,Clp,2
            End If
         End If
      Next
      Gioca Es1,1
   End If
End Function
 
Ultima modifica:
Devi accedere o registrarti per poter rispondere.

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 15 settembre 2026
    Bari
    03
    02
    53
    44
    29
    Cagliari
    85
    81
    31
    53
    23
    Firenze
    27
    40
    34
    71
    81
    Genova
    55
    62
    72
    63
    27
    Milano
    79
    09
    49
    80
    68
    Napoli
    58
    90
    88
    77
    50
    Palermo
    45
    39
    22
    08
    31
    Roma
    39
    41
    04
    54
    63
    Torino
    53
    08
    80
    58
    54
    Venezia
    63
    51
    69
    09
    74
    Nazionale
    16
    45
    75
    60
    18
    Estrazione Simbolotto
    Palermo
    44
    32
    03
    31
    15
    Archivio estrazioni lotto Ritardi top 15 Frequenze top 15

Ultimi Messaggi

Indietro
Alto