Tabellone Analitico

Xeroxs · 29 Maggio 2020

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 · 29 Maggio 2020

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

Codice:

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 · 29 Maggio 2020

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 · 29 Maggio 2020

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

Xeroxs · 29 Maggio 2020

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

Xeroxs · 29 Maggio 2020

Grazie anche a Te
Mike58

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

Xeroxs · 29 Maggio 2020

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 · 2 Giugno 2020

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 · 3 Giugno 2020

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

Codice:

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 · 3 Giugno 2020

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

ciao eugenio

Mike58 · 3 Giugno 2020

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

Codice:

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 · 4 Giugno 2020

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

genios · 4 Giugno 2020

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 · 4 Giugno 2020

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,

Codice:

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 · 4 Giugno 2020

Grazie Mike attendiamo interventi .

Cerca

Cerca

Tabellone Analitico

Xeroxs

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

joe

Advanced Member >PLATINUM PLUS<

i legend

Premium Member

Xeroxs

Advanced Member >PLATINUM<

Xeroxs

Advanced Member >PLATINUM<

Xeroxs

Advanced Member >PLATINUM<

vincenzo4221

Advanced Member >PLATINUM<

Mike58

Advanced Member >PLATINUM PLUS<

genios

Advanced Member >PLATINUM PLUS<

Mike58

Advanced Member >PLATINUM PLUS<

Xeroxs

Advanced Member >PLATINUM<

genios

Advanced Member >PLATINUM PLUS<

Mike58

Advanced Member >PLATINUM PLUS<

genios

Advanced Member >PLATINUM PLUS<

Ultima estrazione Lotto

Ultimi Messaggi