Novità

Tabellone Analitico

Xeroxs

Senior Member
Messaggi
106
Punti reazione
4
Punti
18
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

Advanced Member >PLATINUM PLUS<
Messaggi
2.059
Punti reazione
66
Punti
48
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

Advanced Member >PLATINUM<
Messaggi
1.210
Punti reazione
103
Punti
63
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.

:)
 

Xeroxs

Senior Member
Messaggi
106
Punti reazione
4
Punti
18
Grazie ad Entrambi per le soluzioni proposte provo ad inserirle è modificare i colori
 

Xeroxs

Senior Member
Messaggi
106
Punti reazione
4
Punti
18
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

Advanced Member >PLATINUM<
Messaggi
1.029
Punti reazione
25
Punti
48
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

Advanced Member >PLATINUM PLUS<
Messaggi
2.059
Punti reazione
66
Punti
48
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
 
Ultima modifica:

genios

Advanced Member >GOLD<
Messaggi
792
Punti reazione
10
Punti
18
Mike al tuo ultimo script si potrebbero aggiungere le colonne delle presenze teoriche per livello e per livello progress .

ciao eugenio
 

Mike58

Advanced Member >PLATINUM PLUS<
Messaggi
2.059
Punti reazione
66
Punti
48
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

Senior Member
Messaggi
106
Punti reazione
4
Punti
18
Che Dire un Ottimo Lavoro per Rilevare convergenze Statistiche soprattutto grazie alla scelta Ruote.
Da Parte mai Grazie.
 

genios

Advanced Member >GOLD<
Messaggi
792
Punti reazione
10
Punti
18
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 EugeniioAnalitico su Ruote-1.jpg
 

Mike58

Advanced Member >PLATINUM PLUS<
Messaggi
2.059
Punti reazione
66
Punti
48
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
 

Ultima estrazione Lotto

  • Estrazione del lotto
    martedì 07 luglio 2020
    Bari
    78
    54
    63
    51
    49
    Cagliari
    70
    03
    20
    57
    60
    Firenze
    65
    32
    57
    81
    52
    Genova
    43
    66
    36
    76
    01
    Milano
    50
    22
    54
    86
    85
    Napoli
    88
    44
    31
    06
    08
    Palermo
    82
    04
    88
    31
    59
    Roma
    07
    70
    90
    83
    86
    Torino
    71
    15
    08
    73
    27
    Venezia
    82
    62
    87
    73
    59
    Nazionale
    16
    76
    18
    75
    42

Ultimi Messaggi

Alto