About Me

A minha foto
JRod - PORTUGAL
Microsoft [MVP] - Excel (10º ano consecutivo)
Ver o meu perfil completo
Com tecnologia do Blogger.

Seguidores

Estatisticas

Free Blog Counter

eXTReMe Tracker
2006-05-01
Se pretendermos contar quantas células existem num determinado Range e que contenham valores apresentadas numa determinada cor, ou se quisermos somar os valores com a mesma cor contidos nesse mesmo Range, como no exemplo seguinte:

,

podemos criar duas User Defined Functions (UDF). Por outro lado, para sabermos a que número corresponde cada uma das 56 cores da palette de cores do Excel, podemos utilizar uma macro, que, ao que julgo, é da autoria do MVP Excel - Tom Ogilvy.

Os Códigos:

(Para contar as ocorrências):

Option Explicit

Function CountFc(rng As Range, Num As Long)

    Dim Item
    Application.Volatile
    For Each Item In rng
        If Item.Font.ColorIndex = Num Then CountFc = CountFc + 1
    Next
    
End Function


(Para somar as ocorrências):

Option Explicit


Function SumFC(Source As Range, Num As Long)

Application.Volatile
    Dim total As Double
    Dim cell As Range
    For Each cell In Source
        With cell
            If .Font.ColorIndex = Num Then
                total = total + .Value
            End If
        End With
    Next
    SumFC = total
    
End Function


(Para mostrar a palette de cores):

' By Tom Ogilvy

Sub ShowPalette()

    varr = SetPaletteArray
    Set rng = Cells(1, 1).Resize(7, 8)
    rng.Value = varr
    rng.HorizontalAlignment = xlCenter
    For Each cell In rng
        cell.Interior.ColorIndex = cell.Value
    Next
    Range("A:H").ColumnWidth = 3.29
    Range("A1:H2,A7,H7,E6,E7,F7").Font.ColorIndex = 2
    
End Sub


Public Function SetPaletteArray()


    varr1 = Evaluate(" { 1,53,52,51,49,11,55,56; " & _
                     "9,46,12,10,14,5,47,16;" & _
                     "3,45,43,50,42,41,13,48;" & _
                     "7,44,6,4,8,33,54,15;" & _
                     "38,40,36,35,34,37,39,2;" & _
                     "17,18,19,20,21,22,23,24;" & _
                     "25,26,27,28,29,30,31,32}")


    SetPaletteArray = varr1
End Function


Nota:

Como muito bem refere o MVP Excel - Kiril Lapin (KL), num newsgroup, a este propósito:

" 1) O problema principal, consiste em que o Excel não tem nenhum evento que seja impelido quando muda o formato da célula e, consequentemente, não há maneira de advertir uma fórmula, função, macro, etc., atempadamente, de que a mudança ocorreu.

2) Como se disse, não podemos detectar o momento da mudança do formato, pelo que só nos resta ir checando periodicamente (quanto mais frequentemente melhor). Isto poderá ser conseguido, entre outras coisas, mediante a volatilidade da fórmula."