Novità

Terno Ripetuto

  • Creatore Discussione Creatore Discussione lota
  • Data di inizio Data di inizio
Ecco, Lota. Ora dovrebbe andar bene per Spaziometria

Codice:
Sub Main()
' Per Lota  Terni  che si sono manifestati più volte nelle ultime tot estrazioni
Scrivi " Terno ripetuto (Cinzia) " & Chr(10)
Dim n(3),rur(1),rur1(1)
fin = EstrazioneFin
ini = fin - 19' ultime 20 estrazioni
Scrivi "Dall' estrazione "&Ini&" all' estrazione" &fin
rr = 11
rr1 = 12
rur(1) = rr
rur1(1) = rr1
    For i = 1 To 88
        For j = i + 1 To 89
            For x = j + 1 To 90
            c = 0
            n(1) = i
            n(2) = j
            n(3) = x
            fr = SerieFreqTurbo(Ini,fin,n,rur,3)
            fr1 = SerieFreqTurbo(Ini,fin,n,rur1,3)
            frr = fr + fr1
            If frr > 1 Then
            For es = ini To fin
   
                    For r = 1 To 11
                    If r = 11 Then r = 12
                    If Posizione(es,r,n(1)) > 0 And Posizione(es,r,n(2)) > 0 And Posizione(es,r,n(3)) > 0 Then
                    c = c + 1
                    Messaggio FormatSpace(c,4,1) & ")" & DataEstrazione(es) & "." & FormatSpace(es,4) & "." & Format2(n(1)) & "." & Format2(n(2)) & "." & Format2(n(3))
                    Scrivi FormatSpace(c,4,1) & ")" & DataEstrazione(es) & "." & FormatSpace(es,4) & "." & Format2(n(1)) & "." & Format2(n(2)) & "." & Format2(n(3)) & " ",0,0
                    Scrivi " a " & SiglaRuota(r) & "  ",0,0
                    End If
                    Next
              Next
              End If
              If c > 0 Then Scrivi "casi " & c
            Next
          Next
      Next
 End Sub
 
Buonasera scusate l'intrusione vediamo se con quello che ho capito e inserendo un po del
mio vediamo se questi numeri si ripetono uniti in ambo o superiori ,
ho fatto delle ricerche in passato e sono arrivato all'ambo
bho! vediamo se esce qualcosa vi spiego il mio lavoro
ciaoo e scusatemi per l'intrusione


Salve a tutti voi vi inserisco un metodo del tutto sperimentale che non " dico " non dovete seguire e solo un modo x vedere l'andamento :
Si tratta dei numeri che si ripetono nell'arco dei prossimi 20 estrazioni e se si uniscono in ambo o superiori le ruote sono ovviamente su tt e nz.
BA.74.41.15.69.
CA.11.50.24...............................AMBO A TT 11.50
FI.56.50.87................................FIRENZE 50
GE.47.50....................................
MI.56.32....................................AMBO SECCO 56.32.TT
NA.74.29.06.
VE.56.86.
NZ.29.86.19.
TO.15.42.


1° COLPO
 
BA.74.41.15.69.
CA.11.50.24...............................AMBO A TT 11.50
FI.56.50.87................................FIRENZE 50.56............................A RUOTA SECCA
GE.47.50....................................
MI.56.32....................................AMBO SECCO 56.32.TT
NA.74.29.06.
VE.56.86.
NZ.29.86.19.
TO.15.42.
UNITA CI SAREBBE STATO IL TERNO
 
Ecco, Lota. Ora dovrebbe andar bene per Spaziometria

Codice:
Sub Main()
' Per Lota  Terni  che si sono manifestati più volte nelle ultime tot estrazioni
Scrivi " Terno ripetuto (Cinzia) " & Chr(10)
Dim n(3),rur(1),rur1(1)
fin = EstrazioneFin
ini = fin - 19' ultime 20 estrazioni
Scrivi "Dall' estrazione "&Ini&" all' estrazione" &fin
rr = 11
rr1 = 12
rur(1) = rr
rur1(1) = rr1
    For i = 1 To 88
        For j = i + 1 To 89
            For x = j + 1 To 90
            c = 0
            n(1) = i
            n(2) = j
            n(3) = x
            fr = SerieFreqTurbo(Ini,fin,n,rur,3)
            fr1 = SerieFreqTurbo(Ini,fin,n,rur1,3)
            frr = fr + fr1
            If frr > 1 Then
            For es = ini To fin
  
                    For r = 1 To 11
                    If r = 11 Then r = 12
                    If Posizione(es,r,n(1)) > 0 And Posizione(es,r,n(2)) > 0 And Posizione(es,r,n(3)) > 0 Then
                    c = c + 1
                    Messaggio FormatSpace(c,4,1) & ")" & DataEstrazione(es) & "." & FormatSpace(es,4) & "." & Format2(n(1)) & "." & Format2(n(2)) & "." & Format2(n(3))
                    Scrivi FormatSpace(c,4,1) & ")" & DataEstrazione(es) & "." & FormatSpace(es,4) & "." & Format2(n(1)) & "." & Format2(n(2)) & "." & Format2(n(3)) & " ",0,0
                    Scrivi " a " & SiglaRuota(r) & "  ",0,0
                    End If
                    Next
              Next
              End If
              If c > 0 Then Scrivi "casi " & c
            Next
          Next
      Next
 End Sub
Grazie mille Cinzia27 lo script è perfetto, anche se un solo grazie mi sembra riduttivo visto l'impegno e la disponibilità dimostrata. Buona continuazione di serata
 
ESTRAZIONE FUTURA
Vediamo un pò............ previsione esclusiva per il mese di settembre
29.56.38.02. per tutte le ruote e.nazionale
la scelta a piacere dall'ambo in sù
 
1629905259917.png



SECONDO ME ENTRO AGOSTO SI DOVREBBE RIPETERSI MINIMO L'AMBO ARRIVO A TT
SU RUOTE E DAVVERO DIFFICILE O NON HO STUDIATO ABBASTANZA
 
Ecco l'ultima versione dello script ,ringraziamo LottoTom per il profuso impegno :-)


Codice:
Option Explicit
Class clsUscita
   Public Ruota
   Public idEstr
   Public sData
End Class
Class clsComb
   Public sNumeri
   Public CollUscite
   Sub Class_Terminate
      Set CollUscite = Nothing
   End Sub
   Sub AddUscita(Ruota,idEstr,Data)
      Dim cU
      Set cU = New clsUscita
      cU.Ruota = Ruota
      cU.idEstr = idEstr
      cU.sData = Data
      CollUscite.Add cU
   End Sub
End Class
Sub Main
   Dim Inizio,Fine,idEstr,r,nClasse
   Dim aRuote,nRuoteSel,aNumeri,aComb,sData,aNumScelti,aBNumScelti,nQNumScelti
   Dim CollComb
   nRuoteSel = ScegliRuote(aRuote)
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nClasse = ScegliEsito(3)
   nQNumScelti = ScegliNumeri(aNumScelti )
   If nQNumScelti >= nClasse Then
      ReDim aBNumScelti(90)
      aBNumScelti = ArrayNumeriToBool(aNumScelti)
      Set CollComb = GetNewCollection
      For idEstr = Inizio To Fine
         sData = DataEstrazione(idEstr)
         For r = 1 To nRuoteSel
            If aRuote(r) <> 11 Then
               Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumeri)
               
               Call RimuoviNumeriNonVoluti(aNumeri,aBNumScelti,nClasse)
               
               If aNumeri(1) > 0 Then
                  Call OrdinaMatrice(aNumeri,1)
                  aComb = SviluppoIntegrale(aNumeri,nClasse)
                  Call AddCombInCollection(aComb,nClasse,CollComb,idEstr,aRuote(r),sData)
               End If
            End If
         Next
         Call AvanzamentoElab(Inizio,Fine,idEstr)
         If ScriptInterrotto Then Exit For
      Next
      Call ScriviOutput(CollComb)
      Set CollComb = Nothing
   Else
       MsgBox "Quantita numeri non valida",vbExclamation
   End If
End Sub


Sub RimuoviNumeriNonVoluti(aNumeri,aBNumScelti,nClasse)
    Dim k,i,aNTemp
    
    ReDim aNTemp(UBound(aNumeri))
    For k = 1 To UBound(aNumeri)
       If aBNumScelti(aNumeri(k)) Then
           i = i + 1
           aNTemp(i) = aNumeri(k)
       End If
    Next
    
    If i >= nClasse Then
       ReDim Preserve aNTemp(i)
       aNumeri = aNTemp
    Else
       ReDim aNumeri(1)
       aNumeri(1) = 0
    End If
    
End Sub



Sub AddCombInCollection(aComb,nClasse,CollComb,idEstr,Ruota,sData)
   Dim k,j,sNumeri,cComb,sKey
   For k = 1 To UBound(aComb)
      sNumeri = ""
      For j = 1 To nClasse
         sNumeri = sNumeri & Format2(aComb(k,j)) & "-"
      Next
      sNumeri = RimuoviLastChr(sNumeri,"-")
      sKey = "k" & sNumeri
      If GetItemCollection(CollComb,sKey,cComb) = False Then
         Set cComb = New clsComb
         Set cComb.CollUscite = GetNewCollection
         cComb.sNumeri = sNumeri
         Call AddItemColl(CollComb,cComb,sKey)
      End If
      Call cComb.AddUscita(Ruota,idEstr,sData)
   Next
End Sub
Sub ScriviOutput(CollComb)
   Dim cComb,cU,i,nColor,j,nRipetizioni,nTrov
   Dim aRipetizioni(101)
   For Each cComb In CollComb
      nRipetizioni = cComb.CollUscite.Count
      If nRipetizioni > 1 Then
         If nRipetizioni > 100 Then
            aRipetizioni(101) = aRipetizioni(101) + 1
         Else
            aRipetizioni(nRipetizioni) = aRipetizioni(nRipetizioni) + 1
         End If
         nTrov = nTrov + 1
         ReDim aColori(nRipetizioni)
         For i = 1 To nRipetizioni - 1
            If cComb.colluscite(i).IdEstr = cComb.colluscite(i + 1).IdEstr Then
               aColori(i) = vbRed
               j = i + 1
               Do
                  aColori(j) = vbRed
                  j = j + 1
                  If j > nRipetizioni Then Exit Do
               Loop While cComb.colluscite(j).IdEstr = cComb.colluscite(i).IdEstr
               i = j - 1
            Else
               aColori(i) = vbBlack
            End If
         Next
         Scrivi FormatSpace(nTrov,5,True) & ") " & cComb.sNumeri,True
         i = 0
         For Each cU In cComb.CollUscite
            i = i + 1
            Scrivi "     -> " & FormatSpace(cU.idestr,5) & " " & FormatSpace(cU.sData,5) & " " & NomeRuota(cU.ruota),,,,aColori(i)
         Next
      End If
   Next
   Scrivi
   Scrivi
   Scrivi "Riepilogo",True
   For j = 2 To 100
      If aRipetizioni(j) > 0 Then
         Scrivi "Con " & FormatSpace(j,3) & " ripetizioni  : " & FormatSpace(aRipetizioni(j),5,True)
      End If
   Next
   If aRipetizioni(j) > 0 Then
      Scrivi ">= " & FormatSpace(j,3) & " ripetizioni  : " & FormatSpace(aRipetizioni(j),5,True)
   End If
End Sub
 
Ecco l'ultima versione dello script ,ringraziamo LottoTom per il profuso impegno :)


Codice:
Option Explicit
Class clsUscita
   Public Ruota
   Public idEstr
   Public sData
End Class
Class clsComb
   Public sNumeri
   Public CollUscite
   Sub Class_Terminate
      Set CollUscite = Nothing
   End Sub
   Sub AddUscita(Ruota,idEstr,Data)
      Dim cU
      Set cU = New clsUscita
      cU.Ruota = Ruota
      cU.idEstr = idEstr
      cU.sData = Data
      CollUscite.Add cU
   End Sub
End Class
Sub Main
   Dim Inizio,Fine,idEstr,r,nClasse
   Dim aRuote,nRuoteSel,aNumeri,aComb,sData,aNumScelti,aBNumScelti,nQNumScelti
   Dim CollComb
   nRuoteSel = ScegliRuote(aRuote)
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nClasse = ScegliEsito(3)
   nQNumScelti = ScegliNumeri(aNumScelti )
   If nQNumScelti >= nClasse Then
      ReDim aBNumScelti(90)
      aBNumScelti = ArrayNumeriToBool(aNumScelti)
      Set CollComb = GetNewCollection
      For idEstr = Inizio To Fine
         sData = DataEstrazione(idEstr)
         For r = 1 To nRuoteSel
            If aRuote(r) <> 11 Then
               Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumeri)
             
               Call RimuoviNumeriNonVoluti(aNumeri,aBNumScelti,nClasse)
             
               If aNumeri(1) > 0 Then
                  Call OrdinaMatrice(aNumeri,1)
                  aComb = SviluppoIntegrale(aNumeri,nClasse)
                  Call AddCombInCollection(aComb,nClasse,CollComb,idEstr,aRuote(r),sData)
               End If
            End If
         Next
         Call AvanzamentoElab(Inizio,Fine,idEstr)
         If ScriptInterrotto Then Exit For
      Next
      Call ScriviOutput(CollComb)
      Set CollComb = Nothing
   Else
       MsgBox "Quantita numeri non valida",vbExclamation
   End If
End Sub


Sub RimuoviNumeriNonVoluti(aNumeri,aBNumScelti,nClasse)
    Dim k,i,aNTemp
  
    ReDim aNTemp(UBound(aNumeri))
    For k = 1 To UBound(aNumeri)
       If aBNumScelti(aNumeri(k)) Then
           i = i + 1
           aNTemp(i) = aNumeri(k)
       End If
    Next
  
    If i >= nClasse Then
       ReDim Preserve aNTemp(i)
       aNumeri = aNTemp
    Else
       ReDim aNumeri(1)
       aNumeri(1) = 0
    End If
  
End Sub



Sub AddCombInCollection(aComb,nClasse,CollComb,idEstr,Ruota,sData)
   Dim k,j,sNumeri,cComb,sKey
   For k = 1 To UBound(aComb)
      sNumeri = ""
      For j = 1 To nClasse
         sNumeri = sNumeri & Format2(aComb(k,j)) & "-"
      Next
      sNumeri = RimuoviLastChr(sNumeri,"-")
      sKey = "k" & sNumeri
      If GetItemCollection(CollComb,sKey,cComb) = False Then
         Set cComb = New clsComb
         Set cComb.CollUscite = GetNewCollection
         cComb.sNumeri = sNumeri
         Call AddItemColl(CollComb,cComb,sKey)
      End If
      Call cComb.AddUscita(Ruota,idEstr,sData)
   Next
End Sub
Sub ScriviOutput(CollComb)
   Dim cComb,cU,i,nColor,j,nRipetizioni,nTrov
   Dim aRipetizioni(101)
   For Each cComb In CollComb
      nRipetizioni = cComb.CollUscite.Count
      If nRipetizioni > 1 Then
         If nRipetizioni > 100 Then
            aRipetizioni(101) = aRipetizioni(101) + 1
         Else
            aRipetizioni(nRipetizioni) = aRipetizioni(nRipetizioni) + 1
         End If
         nTrov = nTrov + 1
         ReDim aColori(nRipetizioni)
         For i = 1 To nRipetizioni - 1
            If cComb.colluscite(i).IdEstr = cComb.colluscite(i + 1).IdEstr Then
               aColori(i) = vbRed
               j = i + 1
               Do
                  aColori(j) = vbRed
                  j = j + 1
                  If j > nRipetizioni Then Exit Do
               Loop While cComb.colluscite(j).IdEstr = cComb.colluscite(i).IdEstr
               i = j - 1
            Else
               aColori(i) = vbBlack
            End If
         Next
         Scrivi FormatSpace(nTrov,5,True) & ") " & cComb.sNumeri,True
         i = 0
         For Each cU In cComb.CollUscite
            i = i + 1
            Scrivi "     -> " & FormatSpace(cU.idestr,5) & " " & FormatSpace(cU.sData,5) & " " & NomeRuota(cU.ruota),,,,aColori(i)
         Next
      End If
   Next
   Scrivi
   Scrivi
   Scrivi "Riepilogo",True
   For j = 2 To 100
      If aRipetizioni(j) > 0 Then
         Scrivi "Con " & FormatSpace(j,3) & " ripetizioni  : " & FormatSpace(aRipetizioni(j),5,True)
      End If
   Next
   If aRipetizioni(j) > 0 Then
      Scrivi ">= " & FormatSpace(j,3) & " ripetizioni  : " & FormatSpace(aRipetizioni(j),5,True)
   End If
End Sub

:LOL: Ti stimo fratello Luigi oltre ogni tua immaginazione... :ROFLMAO:(y)😀 e ovviamente, come direbbe Eros..., GRAZIE DI ESISTERE 💪👌👏👍👋:)
 
Buongiorno, mi permetto di fare una richiesta sulla base del listato #62 provato su "bari" con seleziona esito "2".
Se non ho capito male, il risultato è scrivere quante volte una formazione si è ripetuta. Anche se avevo capito che forse inizialmente era solo per rietizioni entro le 20 estrazioni
Allora chiedo, come cosa si dovrebbe cambiare nel listato affinché il risultato non è il seguente

983) 65-86
-> 4235 01.03.1952 Bari
-> 4536 07.12.1957 Bari
-> 4564 21.06.1958 Bari
-> 5568 24.09.1977 Bari
-> 6064 28.03.1987 Bari
-> 6076 20.06.1987 Bari
-> 6104 02.01.1988 Bari
-> 6204 02.12.1989 Bari
-> 6420 22.01.1994 Bari
-> 6938 02.08.2000 Bari
-> 7730 27.03.2007 Bari
-> 8222 18.05.2010 Bari
-> 8275 18.09.2010 Bari
-> 8351 15.03.2011 Bari
-> 8998 02.05.2015 Bari
-> 9074 27.10.2015 Bari
-> 9397 18.11.2017 Bari
-> 9621 26.04.2019 Bari
-> 9622 27.04.2019 Bari
-> 9933 03.06.2021 Bari
-> 9934 05.06.2021 Bari
-> 9954 22.07.2021 Bari

Ma solo il seguente?

983) 65-86
-> 9621 26.04.2019 Bari
-> 9622 27.04.2019 Bari
-> 9933 03.06.2021 Bari
-> 9934 05.06.2021 Bari
-> 9954 22.07.2021 Bari

Cioè solo le ripetizioni nell'estrazione successiva dico.
 
BA.74.41.15.69.........................BA 15.
CA.11.50.24..............................
FI.56.50.87................................
GE.47.50....................................
MI.56.32....................................MI 32
NA.74.29.06.
VE.56.86.
NZ.29.86.19............................NZ 29
TO.15.42.
2°C
 
BA.74.41.15.69.
CA.11.50.24.
FI.56.50.87.
GE.47.50.
MI.56.32.
NA.74.29.06.
VE.56.86.
NZ.29.86.19...........29.86.TT.
TO.15.42.
 

Ultima estrazione Lotto

  • Estrazione del lotto
    giovedì 31 ottobre 2024
    Bari
    16
    03
    32
    19
    10
    Cagliari
    90
    68
    24
    31
    87
    Firenze
    05
    20
    22
    03
    53
    Genova
    15
    16
    69
    05
    36
    Milano
    58
    86
    89
    42
    66
    Napoli
    32
    26
    29
    69
    01
    Palermo
    42
    33
    82
    35
    57
    Roma
    28
    74
    31
    47
    44
    Torino
    15
    75
    07
    20
    39
    Venezia
    25
    47
    73
    67
    01
    Nazionale
    80
    52
    23
    71
    49
    Estrazione Simbolotto
    40
    29
    22
    45
    35
Indietro
Alto