Cerco Listato

LuigiB · 20 Agosto 2021

nessun danno serve per consentire la visuaizzazione della tabella ordinabile che è un controllo ActiveX come ti ho detto il post sopra.

Cinzia27 · 20 Agosto 2021

Ti ringrazio tanto Luigi, sei stato gentilissimo.
E' un capolavoro.

LuigiB · 20 Agosto 2021

Cinzia27 ha scritto:
Ti ringrazio tanto Luigi, sei stato gentilissimo.
E' un capolavoro.

di nulla , ciao

Ramco · 21 Agosto 2021

...Vedere Luigi all'opera è sempre un piacere!!!
Straordinarie sono le sue soluzioni "scriptiche"... e mi stanno muovendo un pò le "farfalle" nello stomaco...

Considerando poi Luigi e Joe insieme.... "il non prus ulta della perfezione"
Un abbraccio circolare ad entrambi

joe · 21 Agosto 2021

Ramco, con me, sempre troppo buono.

Luigi, invece è eccezionale.

Poi ... il suo giocattolo, lo conosce meglio di chiunque altro, anche,

in quelle che a noi, sono sconosciute ed inesplorate potenzialità.

L'avere poi, un sotto-prodotto, di questo programma ultra-professionale

realizzato ad hoc, e con questa complessità, praticamente dalla mattina alla sera,

GRATIS però non è eccezionale.

E' UN FATTO UNICO.

Di cui solo Luigi è capace.

LuigiB · 21 Agosto 2021

eheh grazie , e un saluto a tuti e due .. ma non è niente di speciale . ciao ..

Cinzia27 · 21 Agosto 2021

LuigiB, non sai che bel regalo mi hai fatto. Ora lo vorrei utilizzare al meglio.
Ho già constatato che inserendo una sessantina di numeri lunghezza 7 e sorte 3 dopo un pò mi dice memoria esaurita.
Io volevo addirittura metterne 90 con 24 array sorte 3/4. E' possibile potenziarlo ?
Una domanda a parte, alla fine dell' esecuzione mi chiede quante formazioni vorrei visualizzare, ma se io mettiamo che lascio 100
come di default, mi visualizza le prime 100 secondo l' ordine dei numeri inseriti, io vorrei invece che mi visualizzasse secondo l' ordine crescente dei massimi ritardi storici, è possibile ?
Grazie ancora, Luigi, sei un grande e un generoso.
Un saluto a Ramco e al Jocherellone dai quali tanto ho imparato.

Cinzia27 · 21 Agosto 2021

Luigi, magari si potrebbe mettere un filtro tipo
Se il massimo storico è inferiore a...
poi va benissimo che mi chieda quante formazioni vorrei visualizzare.
Vedi tu, Luigi, se puoi e se hai tempo.
Io sono già molto contenta così.

LuigiB · 21 Agosto 2021

cioa Cinzia , mostra i primi 100 in funzione dell'ordinamento scelto , pero l'errore probabilmente avviene prima.
Mi fai vedere che numeri hai messo ?

LuigiB · 21 Agosto 2021

io per fare un tesat ho alimentato cosi le luinghette , 5 lunghette da 18 numeri prendendoli tutti e 90 e funziona

Codice:

Function AlimentaArrayLunghette(aLunghette)
   ' per comodita le lunghette sono preimpostate ma nulla vieta di leggerle da un file o da inputbox
   ReDim aLunghette(5)
  
  ' aLunghette(1) = Split("0,66,67,69,78,72,89",",") ' 6
  ' aLunghette(2) = Split("0,55,57,59,75,77,86",",") ' 6
  ' aLunghette(3) = Split("0,65,68,79,88",",") '4
  ' aLunghette(4) = Split("0,50,58,54,70,87",",") '5
  ' aLunghette(5) = Split("0,56,52,76,85",",") '4
   
   
   Dim k , kk ,n, sLunghetta 
   For k = 1 To 5
      sLunghetta = "0,"
      For kk  = 1 To 18 
         n = n +1
         sLunghetta = sLunghetta & n & ","
      Next
      sLunghetta = RimuoviLastChr( sLunghetta , ",")
      aLunghette(k) = Split ( sLunghetta ,",")
   Next
   
   
   ' la funzione torna il numero di lunghette ( l'elemento a indice 0 non è usato)
   AlimentaArrayLunghette = UBound(aLunghette)
End Function

LuigiB · 21 Agosto 2021

intanto ho fatto delle aggiunte allo script per renderlo un po ' piu solido , quindi ripartiamo da questo che usa le 5 lunghette da 18

Codice:

Option Explicit
Sub Main
   Dim aLunghette,nQuantitaLung,nClasseFormazione , nMaxClasse
   Dim aRuote,nSorte
   Dim Inizio,Fine
  
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
  
   nQuantitaLung = AlimentaArrayLunghette(aLunghette)
  
  
   If nQuantitaLung >= 2 Then
      If VerificaDoppi(aLunghette) Then
         nMaxClasse = Iif (nQuantitaLung <=10 ,nQuantitaLung ,10 )
         nClasseFormazione = Int(InputBox("Quanti numeri per ogni formazione in gioco da 2 a " & nMaxClasse ))
        
         Call ScegliRuote(aRuote)
         nSorte = ScegliEsito(2,2,nClasseFormazione)
        
        
         If nClasseFormazione >= 2 And nClasseFormazione <= nMaxClasse Then
            Call ProduciFormazioni(aLunghette,nClasseFormazione,aRuote,nSorte,Inizio,Fine)
         Else
            MsgBox "Quantità errata",vbExclamation
         End If
     
      End If
   Else
      MsgBox "Lunghette insufficient",vbExclamation
   End If
End Sub
Function VerificaDoppi(aLunghette)

   Dim k,j,n,sNumeriNonValidi,sNumeriDoppi
   ReDim aB(90)
  
   sNumeriNonValidi = ""
   sNumeriDoppi = ""
  
   For k = 1 To UBound(aLunghette)
      For j = 1 To UBound(aLunghette(k))
         n = Int(aLunghette(k)(j))
         If n > 0 And n <= 90 Then
            If aB(n) Then
                sNumeriDoppi = sNumeriDoppi & " Lunghetta " & k & " numero " & n & ","

            Else
               aB(n) = True
            End If
         Else
            sNumeriNonValidi = sNumeriNonValidi & " Lunghetta " & k & " numero " & n & ","
         End If
      Next
   Next
  
   If sNumeriNonValidi <> "" Or sNumeriDoppi <> "" Then
      If sNumeriNonValidi <> "" Then
         MsgBox "Numeri non validi " & vbCrLf & sNumeriNonValidi,vbExclamation
      End If
      If sNumeriDoppi <> "" Then
         MsgBox "Numeri ripetuti " & vbCrLf & sNumeriDoppi,vbExclamation
      End If
      VerificaDoppi = False
  Else
     VerificaDoppi = True
  End If

  
End Function

Function AlimentaArrayLunghette(aLunghette)
   ' per comodita le lunghette sono preimpostate ma nulla vieta di leggerle da un file o da inputbox
   'ReDim aLunghette(5)
 
  ' aLunghette(1) = Split("0,66,67,69,78,72,89",",") ' 6
  ' aLunghette(2) = Split("0,55,57,59,75,77,86",",") ' 6
  ' aLunghette(3) = Split("0,65,68,79,88",",") '4
  ' aLunghette(4) = Split("0,50,58,54,70,87",",") '5
  ' aLunghette(5) = Split("0,56,52,76,85",",") '4
  
  
   Dim k , kk ,n, sLunghetta
  ReDim aLunghette(5)
  For k = 1 To 5
      sLunghetta = "0,"
      For kk  = 1 To 18
         n = n +1
         sLunghetta = sLunghetta & n & ","
      Next
      sLunghetta = RimuoviLastChr( sLunghetta , ",")
      aLunghette(k) = Split ( sLunghetta ,",")
   Next

   
   ' la funzione torna il numero di lunghette ( l'elemento a indice 0 non è usato)
   AlimentaArrayLunghette = UBound(aLunghette)
End Function
Sub ProduciFormazioni(aLunghette,nClasseFormazione,aRuote,nSorte,Inizio,fine)
   Dim I
   Dim k,aRetColonna,sLungUsate
   Dim aT
   Dim nCombTraLunghette
  
   aT = Array("","Formazione","Ritardo","Frequenza","RitardoMax")
   Call InitTabella(aT)
  
   ReDim aN(UBound(aLunghette))
   For k = 1 To UBound(aN)
      aN(k) = k
   Next
  
   nCombTraLunghette  = Combinazioni ( UBound(aN) , nClasseFormazione )
  
   If MsgBox ("Le combinazioni tra lunghette sono " & nCombTraLunghette & " continuo ?" , vbQuestion + vbYesNo) = vbYes Then
      ReDim aSegni(nClasseFormazione)
      Call InitSviluppoIntegrale(aN,nClasseFormazione)
      Do While GetCombSviluppo(aRetColonna)
         sLungUsate = ""
         For k = 1 To nClasseFormazione
            aSegni(k) = aLunghette(aRetColonna(k))
            sLungUsate = sLungUsate & aRetColonna(k) & "-"
         Next
         Call Messaggio("Sviluppo colonne tra le lunghette " & RimuoviLastChr(sLungUsate,"-"))
         Call SviluppaColonne(aSegni,I,aRuote,nSorte,Inizio,fine)
         If ScriptInterrotto Then Exit Do
         DoEventsEx
      Loop
     
     
      Call Scrivi(String(50,"="))
      Call Scrivi("Colonne sviluppate : " & I)
      Call Scrivi("Classe             : " & nClasseFormazione)
      Call Scrivi("Sorte              : " & nSorte)
      Call Scrivi("Ruote              : " & StringaRuote(aRuote))
      Call Scrivi(String(50,"="))
      Call Scrivi
        
     
     
      Call CreaTabellaOrdinabile(2)
   End If
  
End Sub
Function CalcolaColonneDaSviluppare (aPresPerQ)
   Dim t , k
  
   t = 1
   For k = 1 To UBound(aPresPerQ)
      If aPresPerQ (k) > 0 Then
         t = t * (k ^ aPresPerQ (k))
      End If
   Next
  
   CalcolaColonneDaSviluppare = t
  
End Function
Sub SviluppaColonne(aSegni,I,aRuote,nSorte,Inizio,Fine)
   Dim nClasse,K,aTmp,nPnt
   Dim nRitardo,nRitardoMax,nFrequenza, nDaSviluppare , nSviluppate
  
   ReDim aT(4)
   nClasse = UBound(aSegni)
    
   ReDim aColonna(nClasse)
   ReDim aPuntatore(nClasse)
   ReDim aQSegni(nClasse)
   ReDim aPresPerQuantita (90)
  

   For K = 1 To nClasse
      aTmp = aSegni(K)
      aPuntatore(K) = 1
      aQSegni(K) = UBound(aTmp)
     
      aPresPerQuantita (aQSegni(K)) =aPresPerQuantita (aQSegni(K)) +1

     
   Next
  
   nDaSviluppare = CalcolaColonneDaSviluppare(aPresPerQuantita )
  
  
  
   nPnt = nClasse
   Do
      For K = 1 To nClasse
         aTmp = aSegni(K)
         aColonna(K) = aTmp(aPuntatore(K))
      Next
      I = I + 1
      nSviluppate = nSviluppate + 1
      Call AvanzamentoElab (1 ,nDaSviluppare , nSviluppate)
     
     
     ' Call Scrivi(FormatSpace(I,4,True) & ") " & StringaNumeri(aColonna))
     
      Call StatFrzTurbo(aColonna,aRuote,nSorte,nRitardo,nRitardoMax,0,nFrequenza,,Inizio,Fine)
      aT(1) = StringaNumeri(aColonna)
      aT(2) = nRitardo
      aT(4) = nRitardoMax
      aT(3) = nFrequenza
      Call AddRigaTabella(aT)
     
      Do While aPuntatore(nPnt) + 1 > aQSegni(nPnt)
         nPnt = nPnt - 1
         If nPnt = 0 Then Exit Do
      Loop
      If nPnt > 0 Then
         aPuntatore(nPnt) = aPuntatore(nPnt) + 1
         For K = nPnt + 1 To nClasse
            aPuntatore(K) = 1
         Next
         nPnt = nClasse
      End If
      If ScriptInterrotto Then Exit Do
      DoEventsEx
   Loop While nPnt > 0
End Sub

Cinzia27 · 21 Agosto 2021

Ciao, Luigi per diciottine intendi queste ?

da 1 a 18
da 19 a 36
da 37 a 54
da 55 a 72
de 73 a 90

Ok, solo che nel passo successivo vorrei 24 array che contengono quantità diverse di numeri come nello script che hai postato ieri sera. Ho provato ad aumentare i numeri dell' array ma gira per un pò e poi mi da memoria esaurita.
Vorrei sviluppare sestine, settine o ottine con uno storico non superiore a tot.
Non è necessario che elabori tutte le formazioni possibili ma solo quelle che hanno uno storico non superiore a quello stabilito.
Il ritardo attuale e la frequenza puoi anche non metterli, non sono dati che mi interessano e la loro esclusione potrebbe far risparmiare memoria.

Cinzia27 · 22 Agosto 2021

Questo è quello che vorrei

Codice:

Option Explicit
Sub Main
   Dim aLunghette,nQuantitaLung,nClasseFormazione
   Dim aRuote,nSorte
   Dim Inizio,Fine
  
   Inizio = EstrazioneIni
   Fine = EstrazioneFin
  
   nQuantitaLung = AlimentaArrayLunghette(aLunghette)
  
  
   If nQuantitaLung >= 2 Then'<<<<<<<<<<2
      If VerificaDoppi(aLunghette) Then
         nClasseFormazione = Int(InputBox("Quanti numeri per ogni formazione in gioco da 2 a " & nQuantitaLung))
        
         Call ScegliRuote(aRuote)
         nSorte = ScegliEsito(2,2,nClasseFormazione)
        
        
         If nClasseFormazione >= 2 And nClasseFormazione <= nQuantitaLung Then
            Call ProduciFormazioni(aLunghette,nClasseFormazione,aRuote,nSorte,Inizio,Fine)
         Else
            MsgBox "Quantità errata",vbExclamation
         End If
      
      End If
   Else
      MsgBox "Lunghette insufficient",vbExclamation
   End If
End Sub
Function VerificaDoppi(aLunghette)

   Dim k,j,n,sNumeriNonValidi,sNumeriDoppi
   ReDim aB(90)
  
   sNumeriNonValidi = ""
   sNumeriDoppi = ""
  
   For k = 1 To UBound(aLunghette)
      For j = 1 To UBound(aLunghette(k))
         n = Int(aLunghette(k)(j))
         If n > 0 And n <= 90 Then
            If aB(n) Then
                sNumeriDoppi = sNumeriDoppi & " Lunghetta " & k & " numero " & n & ","

            Else
               aB(n) = True
            End If
         Else
            sNumeriNonValidi = sNumeriNonValidi & " Lunghetta " & k & " numero " & n & ","
         End If
      Next
   Next
  
   If sNumeriNonValidi <> "" Or sNumeriDoppi <> "" Then
      If sNumeriNonValidi <> "" Then
         MsgBox "Numeri non validi " & vbCrLf & sNumeriNonValidi,vbExclamation
      End If
      If sNumeriDoppi <> "" Then
         MsgBox "Numeri ripetuti " & vbCrLf & sNumeriDoppi,vbExclamation
      End If
      VerificaDoppi = False
  Else
     VerificaDoppi = True
  End If

  
End Function

Function AlimentaArrayLunghette(aLunghette)
   ' per comodita le lunghette sono preimpostate ma nulla vieta di leggerle da un file o da inputbox
   ReDim aLunghette(24)
   aLunghette(1) = Split("0,90,89,88,87,86,85",",")
   aLunghette(2) = Split("0,84,83,82,81,80,79",",")
   aLunghette(3) = Split("0,78,77,76,75,74,73",",")
   aLunghette(4) = Split("0,72,71,70,69",",")
   aLunghette(5) = Split("0,68,67,66,65",",")
   aLunghette(6) = Split("0,64,63,62",",")
   aLunghette(7) = Split("0,61,60,59",",")
   aLunghette(8) = Split("0,58,57,56",",")
   aLunghette(9) = Split("0,55,54,53",",")
   aLunghette(10) = Split("0,52",",")
   aLunghette(11) = Split("0,51",",")
   aLunghette(12) = Split("0,50",",")
   aLunghette(13) = Split("0,49",",")
   aLunghette(14) = Split("0,48,47,46",",")
   aLunghette(15) = Split("0,45,44,43",",")
   aLunghette(16) = Split("0,42,41,40",",")
   aLunghette(17) = Split("0,39,38,37",",")
   aLunghette(18) = Split("0,36,35,34",",")
   aLunghette(19) = Split("0,33,32,31",",")
   aLunghette(20) = Split("0,30,29,28,27,26,25",",")
   aLunghette(21) = Split("0,24,23,22,21",",")
   aLunghette(22) = Split("0,20,19,18,17,16,15",",")
   aLunghette(23) = Split("0,14,13,12,11,10,09",",")
   aLunghette(24) = Split("0,08,07,06,05,04,03,02,01",",")
  

'-----------------


  
   Dim k,kk,n,sLunghetta
   For k = 1 To 5
      sLunghetta = "0,"
      For kk = 1 To 18
         n = n + 1
         sLunghetta = sLunghetta & n & ","
      Next
      sLunghetta = RimuoviLastChr(sLunghetta,",")
      aLunghette(k) = Split(sLunghetta,",")
   Next
  
  
'-----------------------

   ' la funzione torna il numero di lunghette ( l'elemento a indice 0 non è usato)
   AlimentaArrayLunghette = UBound(aLunghette)
End Function
Sub ProduciFormazioni(aLunghette,nClasseFormazione,aRuote,nSorte,Inizio,fine)
   Dim I
   Dim k,aRetColonna,sLungUsate
   Dim aT
  
   aT = Array("","Formazione","Ritardo","Frequenza","RitardoMax")
   Call InitTabella(aT)
  
   ReDim aN(UBound(aLunghette))
   For k = 1 To UBound(aN)
      aN(k) = k
   Next
   ReDim aSegni(nClasseFormazione)
   Call InitSviluppoIntegrale(aN,nClasseFormazione)
   Do While GetCombSviluppo(aRetColonna)
      sLungUsate = ""
      For k = 1 To nClasseFormazione
         aSegni(k) = aLunghette(aRetColonna(k))
         sLungUsate = sLungUsate & aRetColonna(k) & "-"
      Next
      Call Messaggio("Sviluppo colonne tra le lunghette " & RimuoviLastChr(sLungUsate,"-"))
      Call SviluppaColonne(aSegni,I,aRuote,nSorte,Inizio,fine)
      If ScriptInterrotto Then Exit Do
      DoEventsEx
   Loop
  
  
   Call Scrivi(String(50,"="))
   Call Scrivi("Colonne sviluppate : " & I)
   Call Scrivi("Classe             : " & nClasseFormazione)
   Call Scrivi("Sorte              : " & nSorte)
   Call Scrivi("Ruote              : " & StringaRuote(aRuote))
   Call Scrivi(String(50,"="))
   Call Scrivi
      
  
  
   'Call CreaTabella(2)
   Call CreaTabellaOrdinabile
  
End Sub
Sub SviluppaColonne(aSegni,I,aRuote,nSorte,Inizio,Fine)
   Dim nClasse,K,aTmp,nPnt
   Dim nRitardo,nRitardoMax,nFrequenza
  
   ReDim aT(4)
   nClasse = UBound(aSegni)
    
   ReDim aColonna(nClasse)
   ReDim aPuntatore(nClasse)
   ReDim aQSegni(nClasse)
   For K = 1 To nClasse
      aTmp = aSegni(K)
      aPuntatore(K) = 1
      aQSegni(K) = UBound(aTmp)
   Next
   nPnt = nClasse
   Do
      For K = 1 To nClasse
         aTmp = aSegni(K)
         aColonna(K) = aTmp(aPuntatore(K))
      Next
      I = I + 1
     ' Call Scrivi(FormatSpace(I,4,True) & ") " & StringaNumeri(aColonna))
      
      Call StatFrzTurbo(aColonna,aRuote,nSorte,nRitardo,nRitardoMax,0,nFrequenza,,Inizio,Fine)
      aT(1) = StringaNumeri(aColonna)
      aT(2) = nRitardo
      aT(3) = nFrequenza
      aT(4) = nRitardoMax
      Call AddRigaTabella(aT)
      
      Do While aPuntatore(nPnt) + 1 > aQSegni(nPnt)
         nPnt = nPnt - 1
         If nPnt = 0 Then Exit Do
      Loop
      If nPnt > 0 Then
         aPuntatore(nPnt) = aPuntatore(nPnt) + 1
         For K = nPnt + 1 To nClasse
            aPuntatore(K) = 1
         Next
         nPnt = nClasse
      End If
      If ScriptInterrotto Then Exit Do
      DoEventsEx
   Loop While nPnt > 0
End Sub

LuigiB · 22 Agosto 2021

ciao a parte che se metti le tue lunghettte devi quantomeno eliminare le mie senno si ricoprono , 24 lunghette sviluppate a combinazioni di 6
danno gia piu di 134mila combinazioni , se consideri poi i relativi sviluppi cssa quante ne escono.

E' chiaro che pur volendolo fare con uno script tutti quei dati non possono entrare in una tabella , qundi devi mettere un if o piu if per fare in modo che nella tabella ci finiscano solo poche colonne.

Cinzia27 · 23 Agosto 2021

Ciao, Luigi. Non importa se non c' è la tabella.
Anche uno script spartano va benissimo.
A me serve quanto richiesto nel messaggio 172-173.

Cinzia27 · 23 Agosto 2021

Con 2-2 su tutte va bene.
Con 3-3 su tutte non mi da nulla

LuigiB · 23 Agosto 2021

quando fa cosi è perche hai detto no al secondo messaggio.
PEr il resto ti ho detot come fare , metti una if per deterimanre quali colonne devono finire nella tabella

Cinzia27 · 23 Agosto 2021

Ho risposto no al primo e si al secondo

LuigiB · 23 Agosto 2021

ah la ruota tt non si puo usare devi selezionare tutte le 10 /111 uote a mano e ottieni lo stesso risultato ... scusa non avevo visto bene.

Cinzia27 · 23 Agosto 2021

No, Luigi. Con tutte funziona ma se metto 2-tutte-2.
Se provo a mettere 3 non funziona.
E a me servivano le lunghette.
Non importa, evidentemente io gli script li devo fare non li devo avere.

Cerco Listato

LuigiB

Guest

Premium Member

LuigiB

Guest

Member

Advanced Member >PLATINUM PLUS<

LuigiB

Guest

Premium Member

Premium Member

LuigiB

Guest

LuigiB

Guest

LuigiB

Guest

Premium Member

Premium Member

LuigiB

Guest

Premium Member

Premium Member

LuigiB

Guest

Premium Member

LuigiB

Guest

Premium Member