contar celdas con formato condicional

13/05/2008 - 07:21 por Cecilia | Informe spam
Hola a todos
He copiado de este mismo grupo estas 3 macros para que me cuente
celdas de un formato condicional (en mi caso fondo rojo), y cuando
introduzco la funcion (=contarcolor(g7:g5000;g3) me da error #valor,
no funciona bien, por favor, me podeis indicar si tengo algo mal en
estas??

Function ContarColor(rango As Range, color As Long)
Dim rngC As Range


For Each rngC In rango.Cells
If rngC.FormatConditions.Count > 0 Then
If ColorIndexOfCF(rngC) = color Then ContarColor ContarColor + 1
ElseIf rngC.Interior.ColorIndex <> color Then ContarColor ContarColor + 1
End If
Next rngC


Set rngC = Nothing
End Function


Function ColorIndexOfCF(Rng As Range, Optional OfText As Boolean False) As Integer


Dim AC As Integer
AC = ActiveCondition(Rng)


If AC = 0 Then
If OfText = True Then
ColorIndexOfCF = Rng.Font.ColorIndex
Else
ColorIndexOfCF = Rng.Interior.ColorIndex
End If
Else
If OfText = True Then
ColorIndexOfCF = Rng.FormatConditions(AC).Font.ColorIndex
Else
ColorIndexOfCF Rng.FormatConditions(AC).Interior.ColorIndex
End If
End If


End Function


Function ActiveCondition(Rng As Range) As Integer


Dim Ndx As Long
Dim FC As FormatCondition


If Rng.FormatConditions.Count = 0 Then
ActiveCondition = 0
Else
For Ndx = 1 To Rng.FormatConditions.Count
Set FC = Rng.FormatConditions(Ndx)
Select Case FC.Type
Case xlCellValue
Select Case FC.Operator
Case xlBetween
If CDbl(Rng.Value) >= CDbl(FC.Formula1) And _
CDbl(Rng.Value) <= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlGreater
If CDbl(Rng.Value) > CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlEqual
If CDbl(Rng.Value) = CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlGreaterEqual
If CDbl(Rng.Value) >= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlLess
If CDbl(Rng.Value) < CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlLessEqual
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlNotEqual
If CDbl(Rng.Value) <> CDbl(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case xlNotBetween
If CDbl(Rng.Value) <= CDbl(FC.Formula1) Or _
CDbl(Rng.Value) >= CDbl(FC.Formula2) Then
ActiveCondition = Ndx
Exit Function
End If


Case Else
Debug.Print "UNKNOWN OPERATOR"
End Select


Case xlExpression
If Application.Evaluate(FC.Formula1) Then
ActiveCondition = Ndx
Exit Function
End If


Case Else
Debug.Print "UNKNOWN TYPE"
End Select


Next Ndx


End If


ActiveCondition = 0


End Function


Muchas gracias por vuestra atención
Un saludo
Cecilia
 

Leer las respuestas

#1 Héctor Miguel
13/05/2008 - 08:05 | Informe spam
hola, Cecilia !

He copiado de este mismo grupo estas 3 macros para que me cuente celdas de un formato condicional (en mi caso fondo rojo)
y cuando introduzco la funcion (=contarcolor(g7:g5000;g3) me da error #valor, no funciona bien
por favor, me podeis indicar si tengo algo mal en estas?? (...)



(no lo he comprobado, pero) parece que en la funcion que expones: Function ActiveCondition(Rng As Range) As Integer
"anda perdida" una funcion auxiliar (o no se traslado correctamente la intencion de esta): -> GetStrippedValue -???-

puedes revisar los codigos originales en la pagina de Chip Pearson:
Conditional Formatting Colors
http://www.cpearson.com/Excel/CFColors.htm

saludos,
hector.

Preguntas similares