Novità

AMBI UGUALI STESSA ESTRAZIONEE

Ciao Alberto, ecco uno script.. ricerca tutti gli ambi uguali anche non isotopi.

Gio.


Codice:
Option Explicit
Sub Main
   ColoreTesto 0
   Scrivi " ***** nome metodo [autore] *****",1
   Scrivi
   ColoreTesto 0
   Dim Fin,Ini,Es,R1,R2,Caso,Casi,P1,P2,P3,P4,Ruote(2)
   Dim N1,N2,N3,N4
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9572)
   Call ScegliRange(EstrazioneIni,Fin,Ini,EstrazioneFin)
   For Es = Ini To Fin
      Caso = 0
      AvanzamentoElab Ini,Fin,Es
      For R1 = 1 To 10
         For R2 = R1 + 1 To 12
            If R2 = 11 Then R2 = 12
            For P1 = 1 To 4
               For P2 = P1 + 1 To 5
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        N1 = Estratto(Es,R1,P1)
                        N2 = Estratto(Es,R1,P2)
                        N3 = Estratto(Es,R2,P3)
                        N4 = Estratto(Es,R2,P4)
                        If N1 = N3 Then
                           If N2 = N4 Then
                              Caso = Caso + 1
                              Casi = Casi + 1
                              Scrivi String(40,"*") & " Casi Totali " & FormattaStringa(Casi,"0000") & String(40,"*"),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) & " " & StringaEstratti(Es,R1),1
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi "  " & SiglaRuota(R2) & " " & StringaEstratti(Es,R2),1
                              Scrivi Space(40) & Format2(N1) & " " & Format2(N2),1,,,2
                              Scrivi
                              Gioca Es,1,,1
                           End If
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
   Next
   ColoreTesto 0
   Scrivi String(65,"•")
   TestoInBandaPassante " ***** nome metodo [autore] ***** ",1,3,0
   ScriviDistribuzioneEsiti(True)
   ScriviDistribuzioneCasiInCorso(True)
   ScriviResoconto
End Sub
 
Ciao Alberto, ecco uno script.. ricerca tutti gli ambi uguali anche non isotopi.

Gio.


Codice:
Option Explicit
Sub Main
   ColoreTesto 0
   Scrivi " ***** nome metodo [autore] *****",1
   Scrivi
   ColoreTesto 0
   Dim Fin,Ini,Es,R1,R2,Caso,Casi,P1,P2,P3,P4,Ruote(2)
   Dim N1,N2,N3,N4
   Fin = EstrazioneFin
   Ini = InputBox("Inserisci l'estrazione che vuoi iniziare",,9572)
   Call ScegliRange(EstrazioneIni,Fin,Ini,EstrazioneFin)
   For Es = Ini To Fin
      Caso = 0
      AvanzamentoElab Ini,Fin,Es
      For R1 = 1 To 10
         For R2 = R1 + 1 To 12
            If R2 = 11 Then R2 = 12
            For P1 = 1 To 4
               For P2 = P1 + 1 To 5
                  For P3 = 1 To 4
                     For P4 = P3 + 1 To 5
                        N1 = Estratto(Es,R1,P1)
                        N2 = Estratto(Es,R1,P2)
                        N3 = Estratto(Es,R2,P3)
                        N4 = Estratto(Es,R2,P4)
                        If N1 = N3 Then
                           If N2 = N4 Then
                              Caso = Caso + 1
                              Casi = Casi + 1
                              Scrivi String(40,"*") & " Casi Totali " & FormattaStringa(Casi,"0000") & String(40,"*"),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) & " " & StringaEstratti(Es,R1),1
                              Scrivi(" Estrazione n." & Format2(Es) & " del " & DataEstrazione(Es)),1,0
                              Scrivi "  " & SiglaRuota(R2) & " " & StringaEstratti(Es,R2),1
                              Scrivi Space(40) & Format2(N1) & " " & Format2(N2),1,,,2
                              Scrivi
                              Gioca Es,1,,1
                           End If
                        End If
                     Next
                  Next
               Next
            Next
         Next
      Next
   Next
   ColoreTesto 0
   Scrivi String(65,"•")
   TestoInBandaPassante " ***** nome metodo [autore] ***** ",1,3,0
   ScriviDistribuzioneEsiti(True)
   ScriviDistribuzioneCasiInCorso(True)
   ScriviResoconto
End Sub
 

Ultima estrazione Lotto

  • Estrazione del lotto
    sabato 25 gennaio 2025
    Bari
    13
    87
    02
    10
    73
    Cagliari
    55
    40
    76
    82
    50
    Firenze
    23
    51
    44
    84
    72
    Genova
    49
    56
    19
    48
    64
    Milano
    40
    27
    80
    13
    47
    Napoli
    67
    37
    02
    75
    81
    Palermo
    25
    28
    11
    31
    40
    Roma
    20
    25
    59
    10
    22
    Torino
    82
    02
    19
    89
    84
    Venezia
    06
    59
    65
    53
    61
    Nazionale
    45
    72
    80
    76
    32
    Estrazione Simbolotto
    Bari
    16
    41
    08
    11
    43
Indietro
Alto