Tabellone Analitico

[Xeroxs]

Ciao, Joe
Non Capisco dove cambiare colore per modificale il giallo, penso che sia collegato ad un codice multicolore ma non lo comprendo , puio darmi la dritta...
Grazie.

 

[Mike58]

Giusto per confronto su modus operandi, vi posto anche la mia versione.

Sub Main
   Dim Nu(5),Cad(5),aN(5),Nu2(1),Nn2,Rsl(5),ru(1)
   Dim T,V
   Ini = EstrazioneFin - 250
   fin = EstrazioneFin
  r =  InputBox("Quale Ruota ",,1)
   ru(1) = r
   Scrivi "*** Analitico Ruota di : " & NomeRuota(r) & " ************** Estratti ********************* Caduti ******************* ",1,,,1,2
   T = Array(T,"Data info","Estratti","I","II","III","IV","V","Liv","Rit","RitSncLiv","C1","C2","C3","C4","C5","LivCad","CadProgress","EsitiFin","RsL / Rit","PresTeoF2","Att2")
   Call InitTabella(T)
   For es = fin To Ini Step - 1
      kk = 0
      For p = 1 To 5
         Nu(p) = Estratto(es,r,p)
         Cad(p) = Estratto(es,r,p)
         aN(p) = Estratto(es,r,p)
         If EstrattoFrequenza(r,Nu(p),es,fin) > 1 Then Nu(p) = "-"
         If EstrattoFrequenza(r,Cad(p),es,fin) = 1 Then Cad(p) = "-"
         If EstrattoFrequenza(r,Nu(p),es,fin) = 1 Then k = k + 1
         If Cad(p) <> "-" Then kk = kk + 1
         If EstrattoFrequenza(r,Nu(p),es,fin) = 1 Then kkk = kkk + 1
      Next
      rit = SerieRitardo(Ini,fin,aN,ru,1)
      ess = fin - es
      Call VerificaEsito(aN,ru,fin,1,,,,,est)
      '............. Ritado di Livello .............................
      Mem2 = 0
      rslA = es'fin - rit
      Nn2 = Split("0." & StringaEstratti(rslA,r),".")
      For p1 = 1 To 5
         Nu2(1) = Nn2(p1)
         rit2 = SerieRitardo(rsla + 1,fin,Nu2,ru,1)'mio rdl
         spA = SeriePrima(rslA + 1,fin,Nu2,ru,1)
         If Mem2 <= spA Then Mem2 = spA
         If Mem2 = rit2 Then Mem2 = rit2
      Next
      If k < 5 Then RslA = fin - Mem2
      If k = 5 Then RslA = rit
      If k < 5 Then Rit2 = fin - Mem2
      If k = 5 Then Rit2 = rit
      presTeo = Round((5*1) *(10/11) ^ ess,4)
      ' Att2 = Round((k/(k + presteo)),3)
      Att2 = Round((Dividi(k,k + PresTeo)),3)
      '---------------------------------------------------------------
      att = Round(Dividi(RslA,ess),2)
      decd = 55 - kkk
      If k > 0 Then
         V = Array(V,GetInfoEstrazione(es),StringaEstratti(es,r),Nu(1),Nu(2),Nu(3),Nu(4),Nu(5),k,ess,RslA,Cad(1),Cad(2),Cad(3),Cad(4),Cad(5),kk,kkk,est,att,PresTeo,Att2)
         Call AddRigaTabella(V)
      End If
      For x = 3 To 7
         Call SetColoreCella((x),6,0)
      Next
      Call SetColoreCella(8,4,0)
      For xx = 11 To 15
         Call SetColoreCella((xx),6,0)
      Next
      If V(9) > 0 And V(10) = 0 Then Call SetColoreCella(18,2,4)
      k = 0
      kk = 0
   Next
   Call SetTableWidth("100%")
   CreaTabellaOrdinabile
   Scrivi "Script By Mike58",1,1,,1,3
End Sub

 

[joe]

Ciao purtroppo i colori sono pochi

e giustamente scrivi che su fondo bianco i colori chiari

non hanno contrasto e sono poco visibili.

I colori del testo CT sono in funzione dei numeri

presenti in ogni rigo con l'automatismo e l'allineamento

ai colori rosso blu che ti aggradano.

Se li vuoi cambiare puoi inserire

Degli if k= 1 the ct = .... If k= 2 the ct =.... Ecc

Ma se gli altri vanno bene

Puoi lasciare ct = k-1 e poi inserire solo quello per la quartina.

Oppure potresti usare case select

Oppure inserire in Array la lista dei colori.

Meglio ancora con spaziometria si può cambiare

anche le sfondo oltre il colore del carattere.

 

[i legend]

Dim aCol(5)
Acol(1)= vbred
Acol(2)=vbblue
Eccc

 

[Xeroxs]

Grazie ad Entrambi per le soluzioni proposte provo ad inserirle è modificare i colori

 

[Xeroxs]

Grazie anche a Te
Mike58

Come Sempre da Quello che ho Visto anche dal passato un Ottimo Lavoro

 

[Xeroxs]

Grazie A Tutti per il Vostro Tempo Dedicato per la mia Richiesta,
Pensavo davvero di non Riuscire ad avere una soluzione, ma Grazie a Voi ho qualcosa che mi può dare degli Spunti.

 

[vincenzo4221]

BRAVISSIMI MIKE E LEGEND, si potrebbe avere il massimo modificando lo script di MIKE , facendogli analizzare 2 ruote unite o max 3, che ne dite ci proviamo?

 

[Mike58]

Ciao Vincenzo modificare il mio script allo scopo No !! diventa complicato raccogliere tutti i dati
Tuttavia prova uno script ex novo semplice con pochi dati, se poi hai bisogno di raccogliere altri dati, fai richiesta in un nuovo post cosi da non intasare questo.

vado di fretta

Sub Main
   Dim Nu(5),T,V
   Ini = EstrazioneFin - 200
   fin = EstrazioneFin
   ReDim Ru(0)
   ScegliRuote(Ru)
   Scrivi "Analitico su Ruote : " & StringaRuote(Ru),1
   T = Array(T,"Rit","Numeri","Livello","Liv Progress")
   Call InitTabella(T)
   For x = 0 To 200
      For y = 1 To 90
         Nu(1) = y
         sr = SerieRitardo(Ini,fin,Nu,Ru,1)
         If sr = x Then
            k = k + 1
            kk = kk + 1
            ReDim Preserve aNum(k)
            aNum(k) = y
         End If
      Next
      If k > 0 Then
         V = Array(V,x,StringaNumeri(aNum),k,kk)
         Call AddRigaTabella(V)
      End If
      k = 0
   Next
   CreaTabella
End Sub

 

[genios]

Mike al tuo ultimo script si potrebbero aggiungere le colonne delle presenze teoriche per livello e per livello progress .

ciao eugenio

 

[Mike58]

Non saprei quanto sia esatto, ma ecco inserito PresTeorica e Attendibilità.

Sub Main
   Dim Nu(5),T,V
   Ini = EstrazioneFin - 200
   fin = EstrazioneFin
   ess = fin - Ini + 1
   ReDim Ru(0)
   ScegliRuote(Ru)
   rr = UBound(Ru)
   Scrivi "Analitico su Ruote : " & StringaRuote(Ru),1
   T = Array(T,"Rit","Numeri","Livello","Liv Progress","PresTeo","Attendibilità")
   Call InitTabella(T)
   For x = 0 To 200
      For y = 1 To 90
         Nu(1) = y
         sr = SerieRitardo(Ini,fin,Nu,Ru,1)
         If sr = x Then
            k = k + 1
            kk = kk + 1
            ReDim Preserve aNum(k)
            aNum(k) = y
         End If
      Next
      presTeo = Round((5*rr) *(10/11) ^ x,3)
      Att2 = Round((Dividi(k,k + PresTeo)),3)
      If k > 0 Then
         V = Array(V,x,StringaNumeri(aNum),k,kk,presTeo,att2)
         Call AddRigaTabella(V)
      End If
      k = 0
   Next
   CreaTabella
End Sub

 

[Xeroxs]

Che Dire un Ottimo Lavoro per Rilevare convergenze Statistiche soprattutto grazie alla scelta Ruote.
Da Parte mai Grazie.

 

[genios]

Grazie Mike della modifica ma intendevo anche sempre se si puo' fare qualcosa del genere in foto . non so se i calcoli sono giusti .

Ciao Eugeniio

 

[Mike58]

Genios, non ho idea, proviamo con la raccolta progressiva di PresenzaTeorica e AttendibitàProgessiva.
Bisognerebbe ragionarci sù ma non essendo un matematico c'è bisogno del ragionamento di tutti,

Sub Main
   Dim Nu(5),T,V
   Ini = EstrazioneFin - 200
   fin = EstrazioneFin
   ess = fin - Ini + 1
   ReDim Ru(0)
   ScegliRuote(Ru)
   rr = UBound(Ru)
   Scrivi "Analitico su Ruote : " & StringaRuote(Ru),1
   T = Array(T,"Rit","Numeri","Livello","Liv Progress","PresTeo(Formula)","Attendibilità","Teorico al Ritardo(Codice)","PresTeoPr","AttPr")
   Call InitTabella(T)
   For x = 0 To 200
      For y = 1 To 90
         Nu(1) = y
         sr = SerieRitardo(Ini,fin,Nu,Ru,1)
         If sr = x Then
            k = k + 1
            kk = kk + 1
            ReDim Preserve aNum(k)
            aNum(k) = y
         End If
      Next
      presTeo = Round((5*rr) *(10/11) ^ x,3)
      Teo = Round(QuantitaTeoricaCombAlRitX(x,1,rr,1),2)
      Att2 = Round((Dividi(k,k + PresTeo)),3)
      '-------------------------------------------
      'PreTeoPr = Round((5*rr) *(10/11) ^ x,3)
      'AttPr = Round((Dividi(k,k + Teo)),3)
      '-------------------------------------------
      PreTeoPr = Round((preTeoPr + Teo),2)
      AttPr = Round((AttPr + Att2),2)
      If k > 0 Then
         V = Array(V,x,StringaNumeri(aNum),k,kk,presTeo,att2,Teo,PreTeoPr,AttPr)
         Call AddRigaTabella(V)
      End If
      k = 0
   Next
   CreaTabella
End Sub

 

[genios]

Grazie Mike attendiamo interventi .