Terno Ripetuto

Cinzia27 · 24 Agosto 2021

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

mastrogino · 24 Agosto 2021

mastrogino ha scritto:
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

Cinzia27 · 24 Agosto 2021

Veramente complimenti, Mastrogino.
A volta abbiamo la vincita a un passo e non sappiamo vederla

mastrogino · 24 Agosto 2021

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

lota · 24 Agosto 2021

Cinzia27 ha scritto:

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

Cinzia27 · 24 Agosto 2021

Un grazie è un grande segno di gentilezza . Buona serata.

i legend · 25 Agosto 2021

lotto_tom75 ha scritto:
Una volta messa... (e ho provato ad inserirla praticamente ovunque... ) mi analizza tranquillamente i 90 numeri totali sbattendosene allegramente di essa...

Ahhhh ahahahah
Siete mitici

mastrogino · 25 Agosto 2021

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ù

mastrogino · 25 Agosto 2021

SECONDO ME ENTRO AGOSTO SI DOVREBBE RIPETERSI MINIMO L'AMBO ARRIVO A TT
SU RUOTE E DAVVERO DIFFICILE O NON HO STUDIATO ABBASTANZA

Cinzia27 · 25 Agosto 2021

La seconda sarebbe 44.75.83 su FI-NZ ?

LuigiB · 25 Agosto 2021

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

lotto_tom75 · 25 Agosto 2021

LuigiB ha scritto:

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

Ti stimo fratello Luigi oltre ogni tua immaginazione...

e ovviamente, come direbbe Eros..., GRAZIE DI ESISTERE

mastrogino · 25 Agosto 2021

Cinzia27 ha scritto:
La seconda sarebbe 44.75.83 su FI-NZ ?

SI ESATTO

AndyLotto · 26 Agosto 2021

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.

mastrogino · 26 Agosto 2021

Ciao LottoMusic scusami x la richiesta ,
potresti inserire la modifica del listato x l'ambo ?
grazie 1000

mastrogino · 26 Agosto 2021

mastrogino ha scritto:
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

AndyLotto · 27 Agosto 2021

Credo lei abbia letto male il mio messaggio.

mastrogino · 2 Settembre 2021

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.

mastrogino · 11 Settembre 2021

mastrogino ha scritto:
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ù

ambo come detto a tt bari 29.56.

Terno Ripetuto

Premium Member

Advanced Premium Member

Premium Member

Advanced Premium Member

Super Member >PLATINUM<

Premium Member

Premium Member

Advanced Premium Member

Advanced Premium Member

Premium Member

LuigiB

Guest

Advanced Premium Member

Advanced Premium Member

Member

Advanced Premium Member

Advanced Premium Member

Member

Advanced Premium Member

Advanced Premium Member