Terno Ripetuto

lotto_tom75 · 23 Agosto 2021

LuigiB ha scritto:
Ciao Tom , avrai copiato male lo script . .io l'ho ripreso da qui e funziona

Non si trattava di quello... (a proposito grazie per la fiducia nelle mie estreme capacità di copy and paste

) ma di qualcosa di molto simile... 👇

Così ad esempio funziona...

Codice:

   Fine = EstrazioneFin
   Inizio = Fine -  20 ' EstrazioneIni

In sostanza... lasciando EstrazioneIni come data di inizio verifica... lo script e il programma impazziscono... per le troppe presenze rilevate!

LuigiB · 23 Agosto 2021

bhe te pareva che non gli volevi tirare i lcollo al mio povero script..comunque non dipende dalle troppe combinazioni ma dal fatto che non gestivo le estrazioni con gli estratti non validi .

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
   Dim CollComb
   
   
   nRuoteSel = ScegliRuote(aRuote)
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nClasse = ScegliEsito(3)
   
   
   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)
            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
   
   
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 · 23 Agosto 2021

LuigiB ha scritto:

bhe te pareva che non gli volevi tirare i lcollo al mio povero script..comunque non dipende dalle troppe combinazioni ma dal fatto che non gestivo le estrazioni con gli estratti non validi .

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
   Dim CollComb
 
 
   nRuoteSel = ScegliRuote(aRuote)
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
   nClasse = ScegliEsito(3)
 
 
   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)
            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
 
 
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

😂

Benchmark test... forever.. yes! 🤣

Non ho guardato se nell'ultimissimo tuo upgrade... soprastante hai messo anche la tabella colorata... per l'analisi di gruppi numerici desiderati anzichè dei soliti moltissimi... ed eccessivi... 90 numeri...

LuigiB · 23 Agosto 2021

hai ffatto bne perche non c'è ...

mastrogino · 23 Agosto 2021

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.
FI.56.50.87.
GE.47.50.
MI.56.32.
NA.74.29.06.
VE.56.86.
NZ.29.86.19.
TO.15.42.

LuigiB · 23 Agosto 2021

LuigiB ha scritto:
hai ffatto bne perche non c'è ...

e perche non mi dici come faresti per mettercelo ?

lotto_tom75 · 23 Agosto 2021

LuigiB ha scritto:
e perche non mi dici come faresti per mettercelo ?

Credi che non ci abbia provato? 🤪 Ma mi risulta piuttosto blindatino da quel punto di vista... non riesco a ficcarla (la tabella... 😂) da nessuna parte... in modo che la senta... 😆. Una volta messa... (e ho provato ad inserirla praticamente ovunque... 😬) mi analizza tranquillamente i 90 numeri totali sbattendosene allegramente di essa... 🥴

LuigiB · 23 Agosto 2021

in questo punto , prende i numeri della ruota diquell'estrazione e li mette in un array.
Se tu vuoi che elabori solo combinazioni dei numeri che vuoi devi eliminare dai numeri presenti nell'array queli che non corrispondono a quelli scelti
e il gioco è fatto.

quindi devi scrivere questa funzione RimuoviNumeriNonVoluti che dovra leggere l'array , mettere a 0 i numeri che non combaciano con quelli voluti , comprimenre l'array rimuovendo gli elementi azzerati.
Inoltre potrebeb darsi che vengano azzerati tutti e in quel caso non deveentrare nel if successivo, oppure che ne vengano azzerati abbastanza per impedire che si formi una combinazione della classe voluta

Codice:

 Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumeri)
            Call RimuoviNumeriNonVoluti (aNumeri , aNumeriScelti)
            If aNumeri (1) > 0 Then

lotto_tom75 · 23 Agosto 2021

LuigiB ha scritto:
in questo punto , prende i numeri della ruota diquell'estrazione e li mette in un array.
Se tu vuoi che elabori solo combinazioni dei numeri che vuoi devi eliminare dai numeri presenti nell'array queli che non corrispondono a quelli scelti
e il gioco è fatto.

quindi devi scrivere questa funzione RimuoviNumeriNonVoluti che dovra leggere l'array , mettere a 0 i numeri che non combaciano con quelli voluti , comprimenre l'array rimuovendo gli elementi azzerati.
Inoltre potrebeb darsi che vengano azzerati tutti e in quel caso non deveentrare nel if successivo, oppure che ne vengano azzerati abbastanza per impedire che si formi una combinazione della classe voluta

Codice:

Call GetArrayNumeriRuota(idEstr,aRuote(r),aNumeri) Call RimuoviNumeriNonVoluti (aNumeri , aNumeriScelti) If aNumeri (1) > 0 Then

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
   Dim CollComb
   Dim Arraydicontrollo
   Arraydicontrollo = Array(0,1,2,3,4,5,6,7,8,9,10)
   nRuoteSel = ScegliRuote(aRuote)
   Fine = EstrazioneFin
   Inizio = Fine - 60 'EstrazioneIni
   'Fine = EstrazioneFin
   nClasse = ScegliEsito(3)
   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)
            Dim nc,nac
            For nc = 0 To UBound(aNumeri)
               For nac = 0 To UBound(Arraydicontrollo)
                  If aNumeri(1) > 0 And aNumeri(nc) = Arraydicontrollo(nac) Then
                     Call OrdinaMatrice(aNumeri,1)
                     aComb = SviluppoIntegrale(aNumeri,nClasse)
                     Call AddCombInCollection(aComb,nClasse,CollComb,idEstr,aRuote(r),sData)
                  End If
               Next
            Next
         End If
      Next
      Call AvanzamentoElab(Inizio,Fine,idEstr)
      If ScriptInterrotto Then Exit For
   Next
   Call ScriviOutput(CollComb)
   Set CollComb = Nothing
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

Timido tentativo.. (non funzionante 🧑‍🍳 ) di sblindare... la cosa... 😶

Adesso...

Tieni... questa è la cinghia... 🤣

LuigiB · 23 Agosto 2021

no piu che altro mi fa piacere che hai fatto come ti ho detto ..

lotto_tom75 · 23 Agosto 2021

LuigiB ha scritto:
no piu che altro mi fa piacere che hai fatto come ti ho detto ..

Fuori tema forever...

Ok ci riprovo...

LuigiB · 23 Agosto 2021

dentro la sub che non hai scritto l'array aNumeri entra con 5 numeri e deve uscire probabilmente o con 5 numeri o con dei numeri in meno , quindi si deve ridimensionare.
Se rimane con 0 o troppi pochi numeri per dare almeno una combinazione della classe voluta , bastera che l'array venga ridimensionato ad 1 e impostato a 0 l'elemento 1

joe · 23 Agosto 2021

Ciao Luigi.

Confermo che l'ultima versione dello script funziona bene.

Cioè quella presente al msg #62.

Mentre la precedente a cui avevo fatto cenno

dava errore nella parte finale del rendiconto.

LuigiB · 23 Agosto 2021

joe ha scritto:
Ciao Luigi.

Confermo che l'ultima versione dello script funziona bene.

Cioè quella presente al msg #62.

Mentre la precedente a cui avevo fatto cenno

dava errore nella parte finale del rendiconto.

perfetto , grazie

ora aspettiamo il post 75 , vero lottototm ?

lotto_tom75 · 23 Agosto 2021

LuigiB ha scritto:
dentro la sub che non hai scritto l'array aNumeri entra con 5 numeri e deve uscire probabilmente o con 5 numeri o con dei numeri in meno , quindi si deve ridimensionare.
Se rimane con 0 o troppi pochi numeri per dare almeno una combinazione della classe voluta , bastera che l'array venga ridimensionato ad 1 e impostato a 0 l'elemento 1

Altro "pasticcio" forse leggermente meno fuori tema dell'altro...

Ho usato l'ingrediente array_push per cercare di cucinare senza esito ovviamente... il vettorevoluto2 finale desiderato... 🧑‍🍳

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
   Dim CollComb
   Dim Arraydicontrollo
   Arraydicontrollo = Array(0,1,2,3,4,5,6,7,8,9,10)
   nRuoteSel = ScegliRuote(aRuote)
   Fine = EstrazioneFin
   Inizio = Fine - 60 'EstrazioneIni
   'Fine = EstrazioneFin
   nClasse = ScegliEsito(3)
   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)
            Dim nc
            Dim nac
            Dim vettorevoluto
            Dim vettorevoluto2
            If aNumeri(1) > 0 Then
               Call RimuoviNumeriNonVoluti(aNumeri,Arraydicontrollo,nc,nac,vettorevoluto)
               'Call OrdinaMatrice(aNumeri,1)
               Call SplitByChar(StringaNumeri(vettorevoluto),".",vettorevoluto2)
               Call OrdinaMatrice(vettorevoluto2,1)
               'aComb = SviluppoIntegrale(aNumeri,nClasse)
               aComb = SviluppoIntegrale(vettorevoluto2,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
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
'quindi devi scrivere questa funzione RimuoviNumeriNonVoluti che dovra leggere l'array ,
'mettere a 0 i numeri che non combaciano con quelli voluti , comprimenre l'array rimuovendo
'gli elementi azzerati. Inoltre potrebeb darsi che vengano azzerati tutti e In quel caso non
'deve entrare nel If successivo, oppure che ne vengano azzerati abbastanza per impedire che
'si formi una combinazione della classe voluta
Function RimuoviNumeriNonVoluti(anumeri,Arraydicontrollo,nc,nac,vettorevoluto)
   For nc = 0 To UBound(anumeri)
      For nac = 0 To UBound(Arraydicontrollo)
         If anumeri(1) > 0 And anumeri(nc) = Arraydicontrollo(nac) Then
            vettorevoluto = array_push(vettorevoluto,StringaNumeri(anumeri(nc)))
         End If
      Next
   Next
End Function
Function array_push(arr,vars)
   ' Dimensiono le variabili interne alla funzione
   Dim k,newelem,newarrsize,elem
   ' Verifico se arr è una array
   If IsArray(arr) Then
      ' Verifico che vars non sia vuoto
      If Len(vars) > 0 Then
         ' Verifico se vars ospita una o più virgole e quindi
         ' se è uno solo o un elenco di elementi.
         ' Se è un solo elemento...
         If InStr(vars,",") = False Then
            ' Incremento di uno il numero di elementi
            newarrsize = CInt(UBound(arr) + 1)
            ReDim Preserve arr(newarrsize)
            ' Aggiungo in coda il nuovo elemento
            arr(newarrsize) = vars
            ' Se vars è un elenco di elementi...
         Else
            ' Definisco un contatore interno con valore di partenza
            ' pari al numero di elementi dell'array originale + 1
            k =(UBound(arr) + 1)
            ' Creo una array con tutti i nuovi elementi da aggiungere
            newelem = Split(vars,",")
            ' Incremento il numero di elementi per contenere quelli nuovi
            newarrsize = CInt(UBound(arr) + UBound(newelem) + 1)
            ReDim Preserve arr(newarrsize)
            ' Ciclo i nuovi elementi per aggiungerli all'array originale
            For Each elem In newelem
               arr(k) = Trim(elem)
               k = k + 1
            Next
         End If
      End If
      array_push = arr
      ' Se arr non è una array la nostra funzione restituisce false
   Else
      array_push = False
   End If
End Function
Function SelEsito
   Dim ret
   Dim aVoci
   'aVoci = Array("","1","2","3","4","5","6","7","8","9","10","11","12","13","14","15","16","17","18","19","20")
   'ret = ScegliOpzioneMenu(aVoci,2," Sviluppo per grado di presenza x punti : ")
   For ret = 1 To 1
      SelEsito = ret
   Next
End Function

LuigiB · 23 Agosto 2021

mi fa piacere che ti dai da fare .. solo che dovresti mettere nella vetrina solo la torta che riesce bene ..
hai capito cosa deve fare la sub ?

p.s.
io voglio ammazzare quell oche ha divulgato sto codice array_push che lo usi come il prezzemolo ...

lotto_tom75 · 23 Agosto 2021

LuigiB ha scritto:
mi fa piacere che ti dai da fare .. solo che dovresti mettere nella vetrina solo la torta che riesce bene ..
hai capito cosa deve fare la sub ?

p.s.
io voglio ammazzare quell oche ha divulgato sto codice array_push che lo usi come il prezzemolo ...

No... Ho capito solo... che sono "sub..." 🤣

lota · 23 Agosto 2021

Cinzia27 ha scritto:
Bene, vedo che siete già attivi.
Quale fine si può dare a questa ricerca sui terni ripetuti?

Buonasera, Cinzia27 è poi riuscita nel suo script a implementare la Nazionale?

Cinzia27 · 23 Agosto 2021

Buonasera, Lota. Ci ho provato ieri , nulla. Ora sto facendo girare uno script, quando finisce ci riprovo.

lota · 23 Agosto 2021

Va bene, faccia pure con comodo e se non riesce fà niente. Buona serata

Terno Ripetuto

Advanced Premium Member

LuigiB

Guest

Advanced Premium Member

LuigiB

Guest

Advanced Premium Member

LuigiB

Guest

Advanced Premium Member

LuigiB

Guest

Advanced Premium Member

LuigiB

Guest

Advanced Premium Member

LuigiB

Guest

Advanced Member >PLATINUM PLUS<

LuigiB

Guest

Advanced Premium Member

LuigiB

Guest

Advanced Premium Member

Super Member >PLATINUM<

Premium Member

Super Member >PLATINUM<