trova valori e colora celle

[miko]

Buona sera,
tra le tante macro che si trovano nel forum relative all'argomento,
in particolare ho tentato di rivisitare le ottime macro del post
http://www.pc-facile.com/forum/viewtopic.php?f=26&t=110942
non riesco ad adattare qualcuna per realizzare quanto segue.
dato un range di R righe e C colonne devo trovare i numeri uguali, colorare le celle e
riportare in una zona vuota del foglio i numeri e le rispettive frequenze.
cambiando il numero di ricerca si deve cambiare il colore delle celle.
in pratica per ogni numero cercato deve corrispondere un colore diverso delle celle.
ho anche il problema della velocita di esecuzione in quanto il procedimento si ripete N volte
poichè' i valori del range di ricerca cambiano molteplici volte.
ciao grazie

[Anthony47]

dato un range di R righe e C colonne devo trovare i numeri uguali, colorare le celle e
riportare in una zona vuota del foglio i numeri e le rispettive frequenze

Quindi in quel tabellone vuoi identificare quali numeri compaiono piu' di una volta e colorarli...

cambiando il numero di ricerca si deve cambiare il colore delle celle.
in pratica per ogni numero cercato deve corrispondere un colore diverso delle celle

... o vuoi impostare da qualche parte il valore da cercare e colorare con un colore specifico le sue presenze sul tabellone?

??

[miko]

Buongiorno,
per il tuo primo quesito la risposta è si, trovare quali numeri sono presenti 1 o più volte.
per la seconda questione i numeri da trovare sono quelli del range di ricerca, per cui
considero la prima riga del range ed il numero della prima cella del range,
trovo nelle righe e colonne successive il numero e coloro le celle;
poi passo alla seconda cella della prima riga del range e ripeto il procedimento associando alle celle un colore diverso.
terminata la ricerca dei numeri della prima riga passo a trovare i numeri della seconda, e cosi via.
faccio notare che passando a trovare i numeri delle righe successive nella restante parte del range,
se il numero è già stato trovato, perchè numero di ricerca presente nelle righe precedenti,
è inutile proseguire la ricerca, si può saltare a cercare il numero successivo.
inoltre in una stessa riga non ci sono ripetizioni dello stesso numero per cui nella ricerca si possono
escludere le colonne della riga in cui si trova il numero e, evidentemente, quando si trova il numero
si può passare a ricercare il numero nelle righe successive.
ciao grazie buona giornata

[Anthony47]

Credo di aver capito.
Immagino che i tuoi numeri siano nel range 1-90, allora sappi che excel gestisce max 56 colori diversi, quindi "troverai duro" identificare colori con 90 sfumature.
Comunque proviamo con questo codice:

Codice: Seleziona tutto

Sub CellColor()
Dim wArea As Range, dBase As String, myC As Range, Riep As String
Dim ccStr As String, ccCol As Long
Dim ColArr(1 To 90)
'
dBase = "B4"        '<<< La "base" dei dati
Riep = "M4"         '<<< La "base" per il riepilogo
'
Set wArea = Range(dBase).CurrentRegion
wArea.Interior.Color = xlNone
For Each myC In wArea
    ColArr(myC.Value) = ColArr(myC.Value) & "," & myC.Address
Next myC
For I = 1 To 90
    ccStr = ColArr(I)
    If (Len(ccStr) - Len(Replace(ccStr, ",", "", , , vbTextCompare))) > 1 Then
        ccCol = RGB(255, 255, 255) / 100 * I
        Range(Mid(ColArr(I), 2)).Interior.Color = ccCol
    End If
    Range(Riep).Cells(I, 1).Interior.Color = ccCol
    Range(Riep).Cells(I, 1) = I
    Range(Riep).Cells(I, 2) = Len(ccStr & " ") - Len(Replace(ccStr & " ", ",", "", , , vbTextCompare))
Next I
End Sub

Le due istruzioni marcate <<< vanno personalizzate come da commento

Nel riepilogo ho tradotto "frequenza" in "conteggio di occorrenze", quindi nel Riepilogo scrivo il numero e quante volte viene trovato; se non e' esatto allora precisa cosa vorresti calcolare.

Ciao

[miko]

Buonasera,
quello che positivamente mi sorprende ogni volta che eseguo una tua macro è la logica creativa usata per la soluzione.
tutto funziona perfettamente, grazie.
ho solo 2 richieste
1
cosa svolge la linea
If (Len(ccStr) - Len(Replace(ccStr, ",", "", , , vbTextCompare))) > 1 Then..... ?
2
il risultato del riepilogo viene inserito in una sola colonna
per avere una visione d'insieme è possibile, se non è troppo laborioso, splittare il risultato in più colonne
ad esempio quando nel ciclo for I... il valore di I raggiunge 10 oppure 20 si cambia colonna?
ciao e grazie per il contributo

p.s.
colgo l'occasione per augurare a tutti gli utenti un felice Natale

[Anthony47]

Quella istruzione conta quante volte quello specifico numero e' stato trovato, visto che ogni occorrenza e' memorizzata in ColArr separata dalla precedente tramite la "virgola".
Per avere l'output su piu' colonne modifichiamo la parte finale della macro:

Codice: Seleziona tutto

Sub CellColor()
Dim wArea As Range, dBase As String, myC As Range, Riep As String
Dim ccStr As String, ccCol As Long
Dim ColArr(1 To 90)
'
dBase = "B4"        '<<< La "base" dei dati
Riep = "M4"         '<<< La "base" per il riepilogo
'
Set wArea = Range(dBase).CurrentRegion
wArea.Interior.Color = xlNone
For Each myC In wArea
    ColArr(myC.Value) = ColArr(myC.Value) & "," & myC.Address
Next myC
Range(Riep).Resize(30, 12).Clear
For I = 1 To 90
    ccStr = ColArr(I)
    If (Len(ccStr) - Len(Replace(ccStr, ",", "", , , vbTextCompare))) > 1 Then
        ccCol = RGB(255, 255, 255) / 100 * I
        Range(Mid(ColArr(I), 2)).Interior.Color = ccCol
        Range(Riep).Cells(1 + (I - 1) Mod 15, 1 + Int((I - 1) / 15) * 2).Interior.Color = ccCol
    End If
    Range(Riep).Cells(1 + (I - 1) Mod 15, 1 + Int((I - 1) / 15) * 2) = I
    Range(Riep).Cells(1 + (I - 1) Mod 15, 2 + Int((I - 1) / 15) * 2) = Len(ccStr & " ") - Len(Replace(ccStr & " ", ",", "", , , vbTextCompare))
Next I
End Sub


In questo modo creiamo 6 colonne da 15 righe ognuna

Ciao

[miko]

salve,
l'ultima macro funziona.
per evitare un compatto range di celle colorate ho pensato di separare il range del riepilogo con delle colonne vuote.
in cima al ciclo For I = 1 To 90 ho inserito queste 3 linee di codice

Codice: Seleziona tutto

For I = 1 To 90

      R = (I - 1) Mod 11 '<<<<
     
      C = (Int((I - 1) / 11) * 2) '<<<<
     
      If C > 0 Then C = C * 2 '<<<
      ......
      ....

in questo modo ottengo le colonne piene separate da 1 colonna vuota.
il codice funziona anche se ad ogni variazione della variabile I si ha una ripetizione delle 3 linee che ho inserito.
forse c'è un modo diverso ?
volevo ottenere un risultato leggermente diverso per una migliore visualizzazione del riepilogo;
indico con P le colonne piene e con V le colonne vuote
il riepilogo dovrebbe essere inserito in questo modo
P V P | V V | P V P | V V | P V P |...
dopo tanti tentativi non sono riuscito.
ciao, grazie

[Anthony47]

Non ho capito se il tuo codice fa quello che vuoi, nel qual caso direi "E' perfetta così".
Se vuoi che il riepilogo abbia una colonna vuota aggiuntiva, io modificherei quei "*2" in *3

Sarebbe anche opportuno anche modificare Range(Riep).Resize(30, 12).Clear in Resize(30,18)

volevo ottenere un risultato leggermente diverso per una migliore visualizzazione del riepilogo;
indico con P le colonne piene e con V le colonne vuote
il riepilogo dovrebbe essere inserito in questo modo
P V P | V V | P V P | V V | P V P |...

Cioe' vorresti che la colonna colorata sia affiancata da una colonna vuota; poi la colonna con il conteggio; poi due colonne vuote; poi ripeti per gli altri 5 blocchi?? Mah, secondo me la risolvi allargando le colonne a piacere dopo aver modificato il *2 in *3

Ciao