Come calcolare delle Celle Colorate per ogni riga

[A.Maurizio]

Ciao a tutti, mi chiamo Maurizio, il mio Problema e questo :
Dalla Cella A1 alla Cella C100 ci sono dei numeri immessi presi a caso da una lista che va dall' 1 al 90 .
Mentre nelle Celle F1:H1 - F2:H2 - F3:H3 inserisco dei numeri da ricercare dalla mia lista .
Ora in tutto ciò , ho adottato una formattazione Condizionale che mi evidenzi tutti i numeri corrispondenti alle celle F1:H1 - F2:H2 - F3:H3 , con Vari Colori di Fondo e di Font, e fino a qui nulla di cosi Eclatante !
Il Problema che vorrei risolvere e questo :
Sempre usando una formattazione Condizionale c'è la possibilità di Far scrivere nella Colonna E1:E100 quante volte ad ogni riga si incontra ( tre Celle ) dello stesso Colore.
Tenendo presente che la Formattazione Condizionale che evidenzia i numeri presi dalle celle (F1:H1) sono di colore Giallo, mentre quelle delle celle (F2:H2) sono di colore Verde, e quelle delle celle (F3:H3) sono di colore Rosso con font Bianco
Ringrazio sin da ora tutti coloro che mi vorranno dare una Mano in merito , Sinceri saluti da Maurizio
Esempio Pratico Basato sul Foglio di calcolo :

A1 B1 C1 E1 F1 G1 H1
------------------------------------------------------------------------------------------------------------------------------------------
1 25 30 60 Calcolo delle 2 Celle di 25 30 80
2 1 40 80 Celle Colorate 2 Riferimento 1 60 80
3 11 32 15 3 11 15 32
4
ecc….!

[Anthony47]

Il colore della formattazione condizionale non e' rilevabile dal vba, quindi bisogna lavorare sulle formule di formattazione condizionale.
Direi che per maggiore chiarezza e semplicita' a lavorare sulla tua domanda e' utile allegare un file di esempio.

Ciao

[A.Maurizio]

Hai Ragione Anthony però c'è sempre il Problema che Io non so come Fare per Inviarti il Tutto .
Però e anche vero che Ieri Sera a forza di provare una qualche soluzione Plausibile , ho provato a scrivere in un Modulo questo
Listato :

Function CountCcolor(range_data As Range, criteria As Range) As Long
Dim datax As Range
Dim xcolor As Long
xcolor = criteria.Interior.ColorIndex
For Each datax In range_data
If datax.Interior.ColorIndex = xcolor Then
CountCcolor = CountCcolor + 1
End If
Next datax
End Function

Dopo di chè , inserendo un Tasto sul Foglio di Lavoro ho provato a richiamare il tutto in questo modo :

Private Sub CommandButton1_Click()
Range("E3").Formula = "=CountCcolor(B3:D3,F3)"
Range("E4").Formula = "=CountCcolor(B4:D4,F4)"
Range("E5").Formula = "=CountCcolor(B5:D5,F5)"
Range("E6").Formula = "=CountCcolor(B6:D6,F6)"
Range("E7").Formula = "=CountCcolor(B7:D7,F7)"
Range("E8").Formula = "=CountCcolor(B8:D8,F8)"
End Sub

Ora devo dire che nel suo Insieme funziona Benissimo , però Capisci che non è attuabile in una lista dove ci sono da prendere in considerazione 8 Colonne di Numeri ho Colori che siano , Per 250 Righe e più .
Tenendo Presente che le Range("E3:E8") di prova Sono le celle che vengono prese in Considerazione per Esprimere il Risultato delle celle Colorate trovate su di ogni Riga .

Mentre le Celle che sono prese in considerazione solo per il Proprio colore di Fondo ho il Loro Font sono "=CountCcolor(B3:D3 fino a
"=CountCcolor(B8:D8 Sempre per quello che riguarda il Mio Programma di Prova .

E per Finire le Celle che Vanno da : ,F3)" alla Cella : ,F8)" Sono le Prime delle Otto Righe Che Vengono prese in Considerazione sia per la Ricerca del proprio numero Corrispondente che Sempre nel mio Caso va Dalla Cella F3:H3 fino alla Cella F8:H8 Con la Condizione "
For Each A In Range("D7:K65500")
If Application.CountIf(Range("M5:R5"), A) >= 1 Then A.Interior.ColorIndex = 6
Next

E sia per Ottenere in Base al Colore Uguale il Totale Delle Celle Dello stesso colore trovate .
Non so sono stato abbastanza chiaro , Però credimi che e già difficile per me dire il tutto con parole semplici figuriamoci poi quando devo Buttare giù il tutto come fate voi .
Sinceri Saluti da Maurizio
(N.B) In pratica chiedo solo di trovare un sistema che possa prendere in considerazione tante righe in un colpo solo dandomi per ogni riga quanti colori sono uguali

[Anthony47]

Mi spiace deluderti, ma se i colori li applichi con una formattazione condizionale (come hai detto che fai) la Function CountCcolor non ti dara' il risultato che aspetti, perche' gli Interior.ColorIndex conteggiati sono quelli dovuti alla formattazione normale di cella; per questo ho detto che bisogna lavorare sulle regole di formattazione condizionale.

Per allegare un file vedi qui: viewtopic.php?f=26&t=80395#p460098
Suggerisco di usare http://www.filedropper.com/
-vai al sito
-premi UploadFile
-scegli il file e premi Enter
-il file verra' caricato su sito e ti sara' un "Link To Share This File With Anyone": copialo e incollalo nel tuo prossimo messaggio

Ciao

[A.Maurizio]

Ciao Anthony Grazie Infinite per tutto ciò che stai Facendo per me comunque ho Appena fatto ciò che mi hai suggerito tu , e il file da Scaricare e a questo Link : http://www.filedropper.com/verificaquan ... assocolore
Sei proprio un Amico Sinceri Saluti da Maurizio

[Anthony47]

Ora in tutto ciò , ho adottato una formattazione Condizionale che mi evidenzi tutti i numeri corrispondenti alle celle F1:H1 - F2:H2 - F3:H3 , con Vari Colori di Fondo e di Font

Nel file che ho scaricato le uniche formattazioni condizionali presenti sono quelle che evidenziano le celle di colonna E (il conteggio dei colori), quindi non so che cosa cosa contare...

Sei proprio un Amico

Aspetta di vedere il conto!

Ciao

[A.Maurizio]

Ciao Anthony arrivati a questo punto non capisco cosa ci sia di cosi problematico , certo per chi lo sa fare .
Ma vedrò di ripetere il mio problema in una prospettiva leggermente diversa ; Allora :
B C D E F G H
Numeri Estratti Numero Colore Codici Color

3 ) 25 30 60 2 25 30 80
4 ) 1 40 80 2 1 60 80
5 ) 11 15 32 3 11 15 32
6 ) 25 60 32 2 25 60 32
7 ) 25 60 32 2 25 60 32
8 ) 25 60 32 2 25 60 32

Ora il Discorso e Questo : In Modulo 1 che tra le altre cose Io Nel mio Prospetto di Prova non lo inserito perché davo per scontato che si potesse capire da sé che quando parlavo di formattazione Condizionale per Evidenziare di colore Giallo alcuni numeri , mentre per altri si potesse usare un Alto colore .
Ma la Formattazione che ho usato e questa cambio solo il Colore ma il discorso non cambia :

Sub IndiceColore()
On Error Resume Next
For Each B In Range("B3:D8")
If Application.CountIf(Range("F3:H3"), B) >= 1 Then B.Interior.ColorIndex = 1
If Application.CountIf(Range("F3:H3"), B) >= 1 Then B.Font.ColorIndex = 2
Next
End Sub

Dopo di che ottenuti i colori corrispondenti che vanno da B3:D3 che sarebbero poi i Numeri Estratti direttamente Dalla SISAL volevo che in E3:E8 usare con L'aiuto di un altro Modulo creare una Sorta infinita di Risultati che mi Sappia dire quante Celle di colore giallo c'è in B3:D3 ; Quante Celle ci sono di Colore Nero in B4:D4 ecc...!
Tutto qui .
(N.B) Avvertimi solo prima caro Amico Canavesano di quanto ammonta il tuo compenso per questa tua consulenza , cosi d Spaventarmi poco alla volta e non tutto insieme grazie .
Sinceri Saluti da Maurizio

[ricky53]

Ciao,
per calcolare quanti on i dati che rispecchiano una certa condizione NON ti occorre colore le celle e tanto meno contare le celle colorate per colore ma BASTA una "Tabella Pivot" ... leggi la guida sull'utilizzo delle Pivot

[A.Maurizio]

Ciao ricky53 grazie per il tuo Intervento , però forse non hai letto bene tutti i miei Post , in quanto ti saresti accorto che Dicevo Questo : Io Ho creato un Modulo che colorava le celle di un certo criterio con colori Diversi in base alle mie giocate .
Porto anche a te un Esempio Pratico , Visto che tutto ciò e scatuito dal fatto che mi sono creato un programmino che mi potesse dare in tempo reale una qualche soluzione in base alle mie giocate del Super Enalotto , e visto che Io settimanalmente gioco una schedina con 6 Colonne per 5 Righe , ho creato in questo modulo una Routine che una volta Avviato il tutto mi colora con Colori diversi da Giocata a giocata l'estrazione avvenuta .
Ora detto questo tutto ciò mi Sembrava già carino e bello da vedersi oltre che utile per i miei Gusti o punti di vista che siano .
Però l'altro giorno mi e venuto una idea che vorrei riuscire a mettere a Puntino e cioè questo :
Ora che sono riuscito anche grazie a voi e questo non lo dimenticherò mai , a colorare tutte queste celle in base alle mie Giocate , perché non posso creare altrettante colonne che mi possano dire in tempo reale quante celle in quella determinata riga sono colorate di Rosso anziché di Giallo ecc...!
Tutto qui .
Io in parte ci sono anche riuscito da me , con questa Routine : Range("E3").Formula = "=CountCcolor(B3:D3,F3)" , Però mi accontentassi solo di una decina di righe nulla Sarebbe in quanto dovrei solo Incrementare tale Routine per dieci volte e il gioco e Fatto .
Però quando il Discorso in questione tiene a Mente le Estrazioni che vanno dal 2010 ad oggi capisci da te che tutto ciò risulta impossibile .
Ecco perché nel mio Prospetto di prova Vorrei riuscire a Trovare un solo Modo per Ricreare la Stessa Cosa che mi scrivesse in E3 il Numero delle celle di colore Giallo che trova a Partire dalla cella B3:D3 e di Colore nero che trova a partire dalla cella B4:D4 ecc....!
tutto qui ! Ecco il perché ti ringrazio del tuo intervento ma non mi sembra una cosa appropriata al mia problema , Sinceri Saluti da Maurizio

[Anthony47]

Il problema e' che hai esordito dicendo che usi la formattazione Condizionale per colorare le celle, ma non e' vero: usi una formattazione standard, quella che imposta un Interior.ColorIndex.
Probabilmente l' hai chiamata "Condizionale" perche' la relativa istruzione e' sotto If (es If Application.CountIf(Range("F3:H3"), B) >= 1 Then B.Interior.ColorIndex = 1).
In realta' in Excel esiste una prestazione che Microsoft chiama (e noi con lei) "formattazione condizionale", in grado di applicare dei colori alle celle in funzione di condizioni programmabili (vedi l' help on line di Excel alla voce "formattazione condizionale") ma non lavora sull' Interior.ColorIndex della cella, per cui puo' accadere che magari Interior.ColorIndex dice "rosso" ma la celle appare "verde".
E' questa seconda formattazione che la funzione CountCcolor non puo' "leggere".

Poiche' pero' tu usi la prima formattazione (quella standard) puoi continuare a usare le formule del tipo =CountCcolor(B3:D3,F3) senza problemi
Se la tua preoccupazione e' che ci sono troppe righe in cui mettere la formula, potresti:
1) aggiungere l' istruzione Application.Volatile subito dopo la riga "Function CountCColor(range_data As Range, criteria As Range) As Long"
2) modificare la macro del commandbutton in

Codice: Seleziona tutto

Private Sub CommandButton1_Click()
Range(Range("D3"), Range("D3").End(xlDown)).Offset(0, 1).ClearContents
Range("E3").Formula = "=CountCcolor(B3:D3,F3)"
Range("E3").Copy Destination:=Range(Range("D3"), Range("D3").End(xlDown)).Offset(0, 1)
Range(Range("D3"), Range("D3").End(xlDown)).Offset(0, 1).Calculate
End Sub

Questa mettera' le formule su tutte le righe della tabella.

TUTTAVIA a me pare che l' architettura complessiva sia debole (macro per colorare le colonne a sinistra, macro per colorare a destra, funzione, formule e pulsante per calcolare le occorrenze...
Ad esempio questa macro:

Codice: Seleziona tutto

Sub colNcount()
Dim myCell As Range, I As Long, LastB As Long, myTot As Long
'
LastB = Range(Range("B3"), Range("B3").End(xlDown)).Count + 2
Cells(3, "B").Resize(LastB - 2, 7).Interior.ColorIndex = xlNone
Cells(3, "B").Resize(LastB - 2, 7).Font.Color = RGB(0, 0, 0)
'
For I = 3 To LastB
    myTot = 0
    Cells(I, "f").Resize(1, 3).Interior.ColorIndex = 4 + (I Mod 2) * 2
    For Each myCell In Cells(I, "B").Resize(1, 3)
        If Application.CountIf(Cells(I, "F").Resize(1, 3), myCell.Value) > 0 Then
            myCell.Interior.ColorIndex = 4 + (I Mod 2) * 2
            myTot = myTot + 1
        End If
    Next myCell
    Cells(I, "E").Value = myTot
Next I
End Sub


Questa macro:
-colora a righe alterne le celle di colonne F:H
-colora le celle di colonna B:D che rientrano nell' elenco di dx
-riporta in colonna E il numero di celle di sx che sono presenti nell' elenco di dx

Mettila in un Modulo standard del vba (es Modulo1) e poi eseguila. Volendo la richiami col Pulsante modificando la sua macro in

Codice: Seleziona tutto

Private Sub CommandButton1_Click()
    Call colNcount
End Sub


Dovrebbe sostituire le varie Sub e la Function che usi ora.

Ciao

[A.Maurizio]

Ciao Anthony Crazie ancora una volta del tuo Proverbiale Intervento , ma visto che Io non mi ritengo una persona che di
natura si Abusa della Pazzienza Altrui, Ti riformulerò per un Ultima volta la mia Domanda , dopo di che non ti chederò più
nulla in meri in quanto capisco che tu come me , devi addempire al uo lavoro e non di certo perdere del tuo tempo
prezzioso nel tentare di risolvere i miei .

Per qui partiro ancora una volta col dire che :

1 ) Sul Foglio 1 a partire dalla cella F3:H8 ho inserito di prova una sorta di Schedina del Super Enalotto che ha come base
( 6 Righe ) Per ( 3 Colonne ) che chiamerò " Mie Giocate " , dirò anche che Sempre per Praticità , ho colorato queste
Righe con Colori Interior diversi e sino a qui nessun Problema .

2 ) Mentre questa volta per Praticità partirò con il dire che a partire dalla Cella B10:D15 che chiamerò " Base Estrazioni "
in qui ci sono dei numeri presi a caso da una Base di Estrazione che và Dall' 1 al 90 Un pò come succede nel vero
Gioco del SuperEnalotto .

Detto Questo ; Partiro con il Dire che sfruttando il Modulo 1 ho scritto questo programmino che verrà poi richiamato a
sua volta da un Pulsante posto sul Foglio 1 , La mia Routine e questa :

Function Genera_Colore1()
On Error Resume Next
For Each A In Range("B10:D15")
If Application.CountIf(Range("F3:H3"), A) >= 1 Then A.Interior.ColorIndex = 6
Next

For Each B In Range("B10:D15")
If Application.CountIf(Range("F4:H4"), B) >= 1 Then B.Interior.ColorIndex = 1
If Application.CountIf(Range("F4:H4"), B) >= 1 Then B.Font.ColorIndex = 2
Next

For Each C In Range("B10:D15")
If Application.CountIf(Range("F5:H5"), C) >= 1 Then C.Interior.ColorIndex = 3
If Application.CountIf(Range("F5:H5"), C) >= 1 Then C.Font.ColorIndex = 2
Next

For Each D In Range("B10:D15")
If Application.CountIf(Range("F6:H6"), D) >= 1 Then D.Interior.ColorIndex = 43
If Application.CountIf(Range("F6:H6"), D) >= 1 Then D.Font.ColorIndex = 2
Next

For Each E In Range("B10:D15")
If Application.CountIf(Range("F7:H7"), E) >= 1 Then E.Interior.ColorIndex = 25
If Application.CountIf(Range("F7:H7"), E) >= 1 Then E.Font.ColorIndex = 2
Next

For Each F In Range("B10:D15")
If Application.CountIf(Range("F8:H8"), F) >= 1 Then F.Interior.ColorIndex = 53
If Application.CountIf(Range("F8:H8"), F) >= 1 Then F.Font.ColorIndex = 2
Next
End Function

Questo modulo ha il Compito di Colorare le Celle Corrispondenti posizionate in B10:D15 in base algli Stessi Colori che
Rirrispondono alle MIe Giocare , e fino a qui nulla di Problematico in quanto questo piccolo Programmino Svolge molto bene
il Suo Compito .

3 ) Ora il mio Problema e solo si fà per dire ? questo :
Avendo Svolto tutto questo lavoro da me a priori , e che ripeto nel mio piccolo funziona Benissimo ! Ora Vorrei sapere
come si potrebbe fare per avere una sorta di contatore Numerico che mi vada a conteggiare Riga per Riga solo prendendo
in Considerazione la perte " Base Estrazioni " e Sfruttando tutta le colonna che vada dalla Cella E10:E65500 in modo
tale che mi sappia dare il numero esatto di quante celle trova in quella determinata Riga dello stesso Colore !
Ora visto che sulla vostra Impaginazione di questo Forum tutto ciò che o sempre impostato in modo molto chiaro in fase
di Scrittura , viene poi sfasato il fase di Salvataggio quando invio una mia richiesta ; partirò semplicemente con il
dire che come sorta di Esempio posso provare a dirvi che :

ad Esempio nella Cella E10 dovrebbe comparire il numero 2 , in quanto andando a verificare le celle di colore giallo che
ci sono nella " Base Estrazioni " il Colore Giallo compare due volte .

Come sempre in forma di Esempio , posso dinuovo dire che in E12 dovrebbe comparirmi il Numero 3 in quanto sulla
" Base Estrazioni " ci sono tutte e tre la Celle colorate di Rosso ; in più il Fatto che io abbia scritto che vorrei che
tale Colonna cioè la E si Incrementabile sino a che possa raggiungere la 65500 cella , non è tanto perchè io voglio
arrivare a tanto , ma semplicemente per il fatto che io Vorrei che tutto ciò non si fermasse alla sola cella E15 ma sappia
all'occorrenza andare oltre ; Tutto qui !

Premetto che Io di mio ho provato questa soluzione :
Range("E10").Formula = "=CountCcolor(B10:D15,F3)" funziona benissimo solo sè io mi accontentassi far valutare una Decina di
Righe della " Base Estrazioni " il problema nasce quando nè vorrei far Valutare un Centinaio ; in quanto non mi metterei
mai di certo a ripetere tale procedura per cento volte e più .

Grazie ancora una volta di tutto il disturbo che ti stò chreando con questo mio Problema , ma sicuramente senza il tuo
aiuto non saprei proprio come fare per imparare sempre di più .
Sinceri saluti con Affetto da Maurizio

[Anthony47]

Scusa, ma la prima macro che ti avevo dato serviva proprio per mettere la formula su tutte le N righe della tua tabella; hai avuto la possibilità di provarla?

Ciao

[A.Maurizio]

Ciao Anthony scusami del Ritardo nel rispondere alle tua Domanda , ma anche io ho i miei impegni di lavoro .
Comunque sia ( Si ) ho provato la tua formula , ma non solo non mi prospetta nulla nella Cella ( E10 : E ) ma mi manda in Crask il programma e non la smette più fin tanto che Io a Forza non riesco a chiudere il Programma .
Sicuramente va benissimo , vorrei che fosse per lo stesso motivo per qui mi succedeva una cosa analoga quando mi avevi dato quella formula per Far si chè si chiudesse si potesse chiudere il MediaPlayer dopo la visione del Filmato .
Cosa che a te funzionava benissimo e a me con Win 8 creava un conflitto ; Tutto qui .
Però sé solo Io riuscissi a Modificare questa macro :

Sub IndiceColore()
On Error Resume Next
Application.Volatile
For Each B In Range("B10:D15")
If Application.Range("E10:E").Formula = "=CountCcolor($B$10:$D$15,F3)" Then

End If
Next
End Sub

In modo Tale che la Cella E potesse andare all'infinito , Io Avrei risolto il mio Problema , Ma prima ho poi ci riuscirò ! Sinceri Saluti e Ancora Grazie di Tutto cuore Amico Canavesano ; da Maurizio

[A.Maurizio]

Ciao Anthony ascolta il tuo primo suggerimento con l'aggiunta di Application.Volatile sembra andare meglio però mi crea questo problema :
B3 C3 D3 E3 F3 G3 H3
VERO Estrazione FALSO Mie Giocate

2 Gialli 25 30 87 2 25 30 80 Giallo
2 Neri 1 60 80 3 1 60 80 Nero
3 Rossi 11 15 32 3 11 15 32 Rosso
2 Verdi 3 45 33 3 3 60 32 Verde
3 Blu 6 61 35 3 6 60 32 Blu
2 Bordoux 39 40 65 3 31 60 32 Bordoux

Dunque la Parte con la Condizione Vera sono i Numeri che Dovrebbero essere realmente Riportate in E3 : E8 .
Mentre Falso e quello che il tuo programma effettivamente mi riporta , che però nella realtà essa mi sta calcolando i colori delle mie giocate e non i colori dei Numeri Estratti .
Perché e come posso ovviare a questo disguido .
Grazie Sinceri Saluti e fai pure con Calma , da Maurizio

[Anthony47]

Ho collaudato i suggerimenti che avevo dato sul file che avevi pubblicato, sia le modifiche che facevano uso delle formule con la funzione CountCColor che la macro che avrebbe potuto sostituire molte delle macro che hai adottato.
In particolare la soluzione che usa CountCColor si limita a inserire la formula nell' intervallo delle celle di colonna E, evitando l' inserimento manuale su lunghe liste.
Se (le formule) vanno bene messe in manuale dovrebbero andare bene anche se messe in automatico.

Purtroppo del file pubblicato io non conosco l' operativita', quindi non so come vanno inseriti e trattati i nuovi dati che, mi pare di capire, non producono i dati desiderati; quindi non so che fare...

Ciao

[A.Maurizio]

Ciao Anthony non ti preoccupare non è successo nulla , anzi mi dispiace tantissimo d'averti fatto perdere tutto questo tempo per risolvere il mio Problema , però nulla toglie il fatto che ti posso inviare il mio programma originale con Winzip che ho già inserito a questo Indirizzo che mi avevi gentilmente fornito tu l'altra volta che è : http://www.filedropper.com/statisticasu ... iamaurizio
Cosi facendo puoi vedere tu dove piazzare il tutto e nel contempo darmi un tuo giudizio , poi vedi tu in base ai tuoi impegni di lavoro se puoi farlo o meno ! Sinceri Saluti da Maury e Grazie ancora di tutto .