Ciao, qualcuno può aiutarmi per favore

joe · 24 Ottobre 2023

Preparare una tabella, colorare le celle ecc. ecc.

è ultile soprattutto a chi deve presentare dei risultati "ben confezionati".

Se invece i risultati sono per "uso proprio" la creazione di una tabella colorata

è un grande dispendio di risorse.

Cioè rallenta e complica molto la situazione.

Nella più parte dei casi, la peggiora sia in termini di codice nel redigere la tabella,

sia per il completamento della medesima, sia per la maggiore quantita di output e memoria necessari.

Il tempo in più ... in genere e per tabelle di piccole dimensioni è trascurabile.

Sono invece MOLTO utili se in esse sono previste funzioni di ordinamento dei risultati.

Quinty · 24 Ottobre 2023

Ciao joe, piacere di conoscerti.
In linea di massima concordo con te anche se a me i colori aiutano molto a concentrarmi solo su quello che sto cercando.
Il listato postato serviva solo per capire meglio alcuni concetti e quindi nella tabella ci ho inserito diverse cose , anche se inutili. Era da esempio.
Saluti.

Quinty · 26 Ottobre 2023

Ciao a tutti,
nei listati che ho postato c'è un problema che riguarda i colpi di gioco.
Se si variano dai 15 colpi impostati in InputBox la tabella risulterà errata, mi scuso ma non ho pensato a altri utenti che volessero usare il listato
Se qualcuno l'ha usata o è interessato a usarla ripubblico i codici corretti.

Codice:

Sub Main
     Dim ru(1),posta(10),num(5),nu(5),nu1(5),pos1(5),pos2(5)
     Dim r1,w,p1,p2,p3,p4,ce,es,clp,clpg,Ini,fin,caso,ambetto1,ambetto2,aRetnum1,nRetvin1
     Dim aRetnum2,nRetvin2,anume1,anume2,cc1,cc2,co1,co2,casi_pos,contat1,contat2,con_tot1,con_tot2
     r1 = CInt(InputBox("RUOTA?",,1))
     p1 = CInt(InputBox("POSIZIONE PRIMO NUMERO DEL PRIMO AMBO?",,1))
     p2 = CInt(InputBox("POSIZIONE SECONO NUMERO DEL PRIMO AMBO?",,3))
     p3 = CInt(InputBox("POSIZIONE PRIMO NUMERO DEL SECONDO AMBO?",,3))
     p4 = CInt(InputBox("POSIZIONE SECONDO NUMERO DEL SECONDO AMBO?",,5))
     w = CInt(InputBox("INDICE MENSILE? ",,1))
     ce = CInt(InputBox("QUANTE ESTRAZIONI CONSIDERO? ",,1000))
     clpg = CInt(InputBox("COLPI DI GIOCO",,15))
     clp = clpg
     Scrivi "RUOTA " & SiglaRuota(r1) & " e tabella per ambetti ",1,,3,,4
     Scrivi "GIOCO SU: " & SiglaRuota(r1) & " - PER COLPI: " & clp,1,,1,4,3
     Scrivi
     ru(1) = r1
     fin = EstrazioneFin
     Ini = EstrazioneFin - ce + 1
     caso = 0
     casi_pos = 0
     ReDim atitoli(9)
     atitoli(1) = " caso "
     atitoli(2) = " DATA ESTRAZIONE "
     atitoli(3) = " RUOTA DI " & NomeRuota(r1)
     atitoli(4) = " NUMERI IN GIOCO "
     atitoli(5) = " ESITO AMBETTO1 "
     atitoli(6) = " COLPI "
     atitoli(7) = " ESITO AMBETTO2 "
     atitoli(8) = " COLPI "
     atitoli(9) = "ESITO COMPLES."
  
     Call InitTabella(atitoli,1,,2,5)
     For es = Ini To fin
     If IndiceMensile(es) = w Then
          caso = caso + 1
          Messaggio "Elaborazione su " & SiglaRuota(r1) & " - estrazione n° " & es & " caso n° " & caso
          
          nu(1) = Estratto(es,r1,p1)
          nu(2) = Estratto(es,r1,p2)
          
          nu1(1) = Estratto(es,r1,p3)
          nu1(2) = Estratto(es,r1,p4)
          
          ReDim avalori(14)
          avalori(1) = caso
          avalori(2) = DataEstrazione(es)
          avalori(3) = StringaEstratti(es,r1)
          avalori(4) = StringaNumeri(nu) & "  -  " & StringaNumeri(nu1)
          
          klp = clp
          
          If EstrazioneFin - es >= clp Then
               clp = clp
          Else
               clp = EstrazioneFin - es
          End If
          
          
          For cc1 = 1 To clp
               If VerificaAmbetto(nu,ru(1),es + cc1,aRetnum1,nRetvin1) Then
                    contat1 = 0
                    anume1 = aRetnum1
                    co1 = cc1
                    casi_pos = casi_pos + 1
                   Exit For
               Else
                    anume1 = " = "
                    co1 = clp
                    If InStr(anume1,"=") And co1 < klp Then anume1 = "In gioco"
                End If
              
          Next
          avalori(5) = anume1
          If co1 = clp And anume1 = " = " Then contat1 = contat1 + 1
          avalori(6) = "neg " & contat1 'co1 & "  n° " & contat1
          If contat1 = 0 Or co1 < klp Then avalori(6) = co1
          
          
           For cc2 = 1 To clp
                If VerificaAmbetto(nu1,ru(1),es + cc2,aRetnum2,nRetvin2) Then
                    contat2 = 0
                    con_tot2 = 0
                    anume2 = aRetnum2
                    co2 = cc2
                    casi_pos = casi_pos + 1
                    Exit For
               Else
                    anume2 = " = "
                    co2 = clp
                    If InStr(anume2,"=") And co2 < klp Then anume2 = "In gioco"
               End If
              
          Next
          avalori(7) = anume2
          If co2 = clp And anume2 = " = " Then contat2 = contat2 + 1
          avalori(8) = "neg " & contat2 'co2 & "  n° " & contat2
          If contat2 = 0 Or co2 < klp Then avalori(8) = co2
          
          If InStr(anume1,"=") And co1 = clp And InStr(anume2,"=") And co2 = clp Then con_tot2 = con_tot2 + 1 Else con_tot2 = 0
          
          avalori(9) = con_tot2
          
          If anume2 = " = " And anume1 = aRetnum1 Then avalori(9) = "colpo: " & co1
          
          If anume1 = " = " And anume2 = aRetnum2 Then avalori(9) = "colpo: " & co2
          
          If anume1 = aRetnum1 And anume2 = aRetnum2 Then avalori(9) = "col: " & co1 & " - col: " & co2
          
          
           Call AddRigaTabella(avalori,,,3)
          
                                   Call SetColoreCella(1,RGB(79,79,79),5)
                                   Call SetColoreCella(2,RGB(128,255,255),1)
                                   Call SetColoreCella(3,RGB(192,192,192),1)
                                   Call SetColoreCella(4,RGB(174,174,255),1)
                                   Call SetColoreCella(5,RGB(128,255,128),1)
                                   Call SetColoreCella(6,RGB(128,255,128),1)
                                   Call SetColoreCella(7,RGB(255,255,128),1)
                                   Call SetColoreCella(8,RGB(255,255,128),1)
                                   Call SetColoreCella(9,3,1)
                                  
          If InStr(anume1,"=") And co1 = clp Then Call SetColoreCella(6,RGB(255,128,64))
          If InStr(anume2,"=") And co2 = clp Then Call SetColoreCella(8,RGB(255,128,64))
          
          If InStr(anume1,"gioco") Then Call SetColoreCella(5,RGB(128,255,128),2)
          If InStr(anume1,"gioco") Then Call SetColoreCella(6,6)
          
          If InStr(anume2,"gioco") Then Call SetColoreCella(7,RGB(255,255,128),2)
          If InStr(anume2,"gioco") Then Call SetColoreCella(8,6)
          
          If InStr(anume1,"=") And co1 = clp And InStr(anume2,"=") And co2 = clp Then Call SetColoreCella(9,2)
          
          If InStr(anume1,"gioco") And InStr(anume2,"gioco") Then Call SetColoreCella(9,6)
          
      End If
          If ScriptInterrotto Then Exit Sub
     Next
     SetTableWidth("90%")
     CreaTabella
     Scrivi "GIOCO SU: " & SiglaRuota(r1) & " - PER COLPI: " & clpg & " casi positivi " & casi_pos & "/" & caso,1,,1,4,3

End Sub

Quinty · 26 Ottobre 2023

Per ambo a tutte (solo correzione colpi di gioco) richiesto da Alien

Codice:

Sub Main
     Dim ru(1),posta(10),num(5),nu(5),nu1(5),pos1(5),pos2(5)
     Dim r1,r2,w,ce,es,clp,clpg,Ini,fin,caso,ambetto1,ambetto2,aRetnum1,nRetvin1
     Dim aRetnum2,nRetvin2,anume1,anume2,cc1,cc2,co1,co2,casi_pos
     pos1(2) = 1
    
     r1 = CInt(InputBox("RUOTA DI CALCOLO",,1))
     w = CInt(InputBox("INDICE MENSILE? ",,1))
     r2 = CInt(InputBox("RUOTA DI GIOCO",,11))
     ce = CInt(InputBox("QUANTE ESTRAZIONI CONSIDERO? ",,1000))
     clpg = CInt(InputBox("COLPI DI GIOCO",,15))
     clp = clpg
     Scrivi "RUOTA DI CALCOLO: " & SiglaRuota(r1),1,,3,,4
     Scrivi "GIOCO PER 2 AMBI SU: " & SiglaRuota(ru(1)) & " - PER COLPI: " & clp,1,,1,4,3
     Scrivi
     Scrivi
     fin = EstrazioneFin
     Ini = EstrazioneFin - ce
     caso = 0
     ReDim atitoli(8)
     atitoli(1) = " caso "
     atitoli(2) = " DATA ESTRAZIONE "
     atitoli(3) = " RUOTA DI " & NomeRuota(r1)
     atitoli(4) = " NUMERI IN GIOCO "
     atitoli(5) = " ESITO AMBO 1 TUTTE "
     atitoli(6) = " COLPI "
     atitoli(7) = " ESITO AMBO 2 TUTTE"
     atitoli(8) = " COLPI "
  
     Call InitTabella(atitoli,1,,2,5)
     For es = Ini To fin
     If IndiceMensile(es) = w Then
          caso = caso + 1
          Messaggio "Elaborazione su " & SiglaRuota(r1) & " - estrazione n° " & es & " caso n° " & caso
          AvanzamentoElab Ini,fin,es
          nu(1) = Estratto(es,r1,1)
          nu(2) = Estratto(es,r1,3)
          
          nu1(1) = Estratto(es,r1,3)
          nu1(2) = Estratto(es,r1,5)
          
          ru(1) = r2
          ReDim avalori(8)
          avalori(1) = caso
          avalori(2) = DataEstrazione(es)
          avalori(3) = StringaEstratti(es,r1)         
          avalori(4) = SiglaRuota(11) & " ... " & StringaNumeri(nu) & "  -  " & StringaNumeri(nu1)
          
          If VerificaEsito(nu,ru,es + 1,2,clp,,RetEsito1,RetColpi1) Then
          anume1 = RetEsito1
          co1 = RetColpi1
          Else
          anume1 = "="
          co1 = RetColpi1
          End If
          If InStr(anume1,"=") And co1 < clp Then anume1 = "In gioco"
          avalori(5) = anume1
          avalori(6) = co1
          
          If VerificaEsito(nu1,ru,es + 1,2,clp,,RetEsito2,RetColpi2) Then
          anume2 = RetEsito2
          co2 = RetColpi2
          Else
          anume2 = "="
          co2 = RetColpi2
          End If
          If InStr(anume2,"=") And co2 < clp Then anume2 = "In gioco"
          avalori(7) = anume2
          avalori(8) = co2

          Call AddRigaTabella(avalori,,,3)
          
                                   Call SetColoreCella(1,RGB(79,79,79),5)
                                   Call SetColoreCella(2,RGB(128,255,255),1)
                                   Call SetColoreCella(3,RGB(192,192,192),1)
                                   Call SetColoreCella(4,RGB(174,174,255),1)
                                   Call SetColoreCella(5,RGB(128,255,128),1)
                                   Call SetColoreCella(6,RGB(128,255,128),1)
                                   Call SetColoreCella(7,RGB(255,255,128),1)
                                   Call SetColoreCella(8,RGB(255,255,128),1)
                                  
          If InStr(anume1,"") And co1 = clp Then Call SetColoreCella(6,2)
          If InStr(anume2,"") And co2 = clp Then Call SetColoreCella(8,2)
          
          If InStr(anume1,"gioco") Then Call SetColoreCella(5,RGB(128,255,128),2)
          If InStr(anume1,"gioco") Then Call SetColoreCella(6,6)
          
          If InStr(anume2,"gioco") Then Call SetColoreCella(7,RGB(255,255,128),2)
          If InStr(anume2,"gioco") Then Call SetColoreCella(8,6)
          
Scrivi DataEstrazione(es) & "  " & String(80,"=") & " caso n° " & caso,1,,,1,3
Scrivi "Rota di calcolo: " & SiglaRuota(r1) & "  " & StringaEstratti(es,r1) & "  Ruota di gioco: " & SiglaRuota(ru(1)) & "  Indice Mensile: " & w _
  & "  Per colpi: " & clp,1,,,1,3
Scrivi


          ImpostaGiocata 1,nu,ru,pos1,clp
          ImpostaGiocata 2,nu1,ru,pos1,clp
          
          Gioca es,1
          
     End If
     If ScriptInterrotto Then Exit Sub
     Next
     SetTableWidth("90%")
     Scrivi
     Scrivi
     CreaTabella
     Scrivi
     Scrivi
ScriviResoconto

End Sub

Alien. · 27 Ottobre 2023

Quinty ha scritto:

Per ambo a tutte (solo correzione colpi di gioco) richiesto da Alien

Codice:

Sub Main
     Dim ru(1),posta(10),num(5),nu(5),nu1(5),pos1(5),pos2(5)
     Dim r1,r2,w,ce,es,clp,clpg,Ini,fin,caso,ambetto1,ambetto2,aRetnum1,nRetvin1
     Dim aRetnum2,nRetvin2,anume1,anume2,cc1,cc2,co1,co2,casi_pos
     pos1(2) = 1
  
     r1 = CInt(InputBox("RUOTA DI CALCOLO",,1))
     w = CInt(InputBox("INDICE MENSILE? ",,1))
     r2 = CInt(InputBox("RUOTA DI GIOCO",,11))
     ce = CInt(InputBox("QUANTE ESTRAZIONI CONSIDERO? ",,1000))
     clpg = CInt(InputBox("COLPI DI GIOCO",,15))
     clp = clpg
     Scrivi "RUOTA DI CALCOLO: " & SiglaRuota(r1),1,,3,,4
     Scrivi "GIOCO PER 2 AMBI SU: " & SiglaRuota(ru(1)) & " - PER COLPI: " & clp,1,,1,4,3
     Scrivi
     Scrivi
     fin = EstrazioneFin
     Ini = EstrazioneFin - ce
     caso = 0
     ReDim atitoli(8)
     atitoli(1) = " caso "
     atitoli(2) = " DATA ESTRAZIONE "
     atitoli(3) = " RUOTA DI " & NomeRuota(r1)
     atitoli(4) = " NUMERI IN GIOCO "
     atitoli(5) = " ESITO AMBO 1 TUTTE "
     atitoli(6) = " COLPI "
     atitoli(7) = " ESITO AMBO 2 TUTTE"
     atitoli(8) = " COLPI "
 
     Call InitTabella(atitoli,1,,2,5)
     For es = Ini To fin
     If IndiceMensile(es) = w Then
          caso = caso + 1
          Messaggio "Elaborazione su " & SiglaRuota(r1) & " - estrazione n° " & es & " caso n° " & caso
          AvanzamentoElab Ini,fin,es
          nu(1) = Estratto(es,r1,1)
          nu(2) = Estratto(es,r1,3)
        
          nu1(1) = Estratto(es,r1,3)
          nu1(2) = Estratto(es,r1,5)
        
          ru(1) = r2
          ReDim avalori(8)
          avalori(1) = caso
          avalori(2) = DataEstrazione(es)
          avalori(3) = StringaEstratti(es,r1)       
          avalori(4) = SiglaRuota(11) & " ... " & StringaNumeri(nu) & "  -  " & StringaNumeri(nu1)
        
          If VerificaEsito(nu,ru,es + 1,2,clp,,RetEsito1,RetColpi1) Then
          anume1 = RetEsito1
          co1 = RetColpi1
          Else
          anume1 = "="
          co1 = RetColpi1
          End If
          If InStr(anume1,"=") And co1 < clp Then anume1 = "In gioco"
          avalori(5) = anume1
          avalori(6) = co1
        
          If VerificaEsito(nu1,ru,es + 1,2,clp,,RetEsito2,RetColpi2) Then
          anume2 = RetEsito2
          co2 = RetColpi2
          Else
          anume2 = "="
          co2 = RetColpi2
          End If
          If InStr(anume2,"=") And co2 < clp Then anume2 = "In gioco"
          avalori(7) = anume2
          avalori(8) = co2

          Call AddRigaTabella(avalori,,,3)
        
                                   Call SetColoreCella(1,RGB(79,79,79),5)
                                   Call SetColoreCella(2,RGB(128,255,255),1)
                                   Call SetColoreCella(3,RGB(192,192,192),1)
                                   Call SetColoreCella(4,RGB(174,174,255),1)
                                   Call SetColoreCella(5,RGB(128,255,128),1)
                                   Call SetColoreCella(6,RGB(128,255,128),1)
                                   Call SetColoreCella(7,RGB(255,255,128),1)
                                   Call SetColoreCella(8,RGB(255,255,128),1)
                                
          If InStr(anume1,"") And co1 = clp Then Call SetColoreCella(6,2)
          If InStr(anume2,"") And co2 = clp Then Call SetColoreCella(8,2)
        
          If InStr(anume1,"gioco") Then Call SetColoreCella(5,RGB(128,255,128),2)
          If InStr(anume1,"gioco") Then Call SetColoreCella(6,6)
        
          If InStr(anume2,"gioco") Then Call SetColoreCella(7,RGB(255,255,128),2)
          If InStr(anume2,"gioco") Then Call SetColoreCella(8,6)
        
Scrivi DataEstrazione(es) & "  " & String(80,"=") & " caso n° " & caso,1,,,1,3
Scrivi "Rota di calcolo: " & SiglaRuota(r1) & "  " & StringaEstratti(es,r1) & "  Ruota di gioco: " & SiglaRuota(ru(1)) & "  Indice Mensile: " & w _
  & "  Per colpi: " & clp,1,,,1,3
Scrivi


          ImpostaGiocata 1,nu,ru,pos1,clp
          ImpostaGiocata 2,nu1,ru,pos1,clp
        
          Gioca es,1
        
     End If
     If ScriptInterrotto Then Exit Sub
     Next
     SetTableWidth("90%")
     Scrivi
     Scrivi
     CreaTabella
     Scrivi
     Scrivi
ScriviResoconto

End Sub

Ciao Quinty grazie per la tua cortesia---- sei ti è possibile avevo chiesto :::: i 5 estratti di ogni ruota su tutte con input ID mese ed il resoconto con le frequenze ruota per ruota, ti è possibile , grazie,

Cerca

Cerca

Ciao, qualcuno può aiutarmi per favore

joe

Advanced Member >PLATINUM PLUS<

Quinty

Junior Member

Quinty

Junior Member

Quinty

Junior Member

Alien.

Advanced Premium Member

Ultima estrazione Lotto

Ultimi Messaggi