About Me
Com tecnologia do Blogger.
Seguidores
Estatisticas
2006-05-01
VBA: UDF's: contar ocorrências e somar valores, mediante a formatação (cor) dos valores inseridos
9:25 da tarde |
Publicada por
JRod - PORTUGAL |
Editar mensagem
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."
,
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."