Contar Células Coloridas pela Formatação Condicional

Olá pessoal.

Eu já havia escrito um artigo semelhante ao que vocês lerão agora, contudo, muitas pessoas vêm me pedindo uma melhoria nele para atender às células que tem seus backgrounds definidos dinamicamente via Formatação condicional.

Então. Hoje vou mostrar como fazer isso. Para quem não leu a matéria anterior sobre este assunto, leia para entender melhor este artigo.

Vou transcrever aqui, o comentário do leitor Alex que solicitou esta dica recentemente no dia 26 de junho de 2010.

Muito boa essa ajuda. Contudo se a celula por formatada condicionalmente esse aplicativo não funcional. Ex.: Formato a celula condicionalmente para amarelo se o valor for igual a 5. Coloco esse valor em na celula e ela muda de cor automatica pelo sistema. Só que essa formula nao reconhece a celular como amarelo. Apenas como branca. Mesmo ela estando amarela. Tem como resolver isso?

Bem, caros leitores, existe sim a possibilidade de fazer uma contagem de células que são “coloridas” pela formatação condicional. Seguindo a mesma metodologia da versão desenvolvida anteriormente, essa fórmula será chamada através da seguinte fórmula personalizada, digitada diretamente na célula onde se quer exibir a contagem.

Exemplo:

=ContaCelulaColoridaFormatCond(D6;$A$2:$A$30)

Onde em D6 está uma célula “colorida” com a cor que deseja exibir a contagem.

No final deste artigo, está disponível um arquivo de exemplo para você baixar e entender melhor o funcionamento.

Abaixo, vou descrever o código que executará toda esta tarefa. Lembre-se, este código deverá ser colocado em um módulo global no ambiente de desenvolvimento VBA. Para abrir o editor VBA, tecle ALT+F11.

No módulo.

Option Explicit

Public Function ContaCelulaColoridaFormatCond(rngColorInfo As Range, Intervalo As Range) As Long
Dim rConta As Range

    For Each rConta In Intervalo.Cells
        If RetornaCorDeFundoCondicional(rConta) = rngColorInfo.Interior.ColorIndex Then
            ContaCelulaColoridaFormatCond = ContaCelulaColoridaFormatCond + 1
        End If
    Next

End Function

Public Function RetornaCorDeFundoCondicional(ByVal rngCelula As Range) As Long
Dim FormatCondition As FormatCondition

    RetornaCorDeFundoCondicional = -1

    For Each FormatCondition In rngCelula.FormatConditions
        If StatusDoFormatoCondicional(FormatCondition) Then
            If Not IsNull(FormatCondition.Interior.ColorIndex) Then
                RetornaCorDeFundoCondicional = FormatCondition.Interior.ColorIndex
            End If
            Exit For
        End If
    Next FormatCondition

End Function

Public Function StatusDoFormatoCondicional(ByVal FormatCondition As FormatCondition) As Boolean
Dim FormulaTransformada As String
Dim Operator As Long
Dim Formula1 As String
Dim Formula2 As String
Dim Cell As Range
Dim CellValue As String

FormulaTransformada = FormatCondition.Formula1
Set Cell = FormatCondition.Parent

On Error Resume Next
Operator = FormatCondition.Operator
On Error GoTo 0

   If Operator > 0 Then
      Formula1 = FormatCondition.Formula1
      On Error Resume Next
      If Left(Formula1, 1) = "=" Then Formula1 = Mid(Formula1, 2)
      Formula2 = FormatCondition.Formula2
      On Error GoTo 0
      If Left(Formula2, 1) = "=" Then Formula2 = Mid(Formula2, 2)
      If VarType(Cell.Value) = vbString Then
         CellValue = """" & Cell.Value & """"
      Else
         CellValue = CDbl(Cell.Value)
      End If
      Select Case Operator
         Case xlBetween:      FormulaTransformada = "AND(" & Formula1 & "<=" & CellValue & "," & CellValue & "<=" & Formula2 & ")"          Case xlNotBetween:   FormulaTransformada = "OR(" & Formula1 & ">" & CellValue & "," & CellValue & ">" & Formula2 & ")"
         Case xlEqual:        FormulaTransformada = CellValue & "=" & Formula1
         Case xlNotEqual:     FormulaTransformada = CellValue & "<>" & Formula1
         Case xlGreater:      FormulaTransformada = CellValue & ">" & Formula1
         Case xlLess:         FormulaTransformada = CellValue & "<" & Formula1          Case xlGreaterEqual: FormulaTransformada = CellValue & ">=" & Formula1
         Case xlLessEqual:    FormulaTransformada = CellValue & "<=" & Formula1
      End Select
   Else
      FormulaTransformada = FormatCondition.Formula1
      If Application.Version < 12 Then
         If Application.ReferenceStyle = xlA1 Then
            FormulaTransformada = Application.ConvertFormula(FormulaTransformada, xlA1, xlR1C1, , ActiveCell)
            FormulaTransformada = Application.ConvertFormula(FormulaTransformada, xlR1C1, xlA1, xlAbsolute, Cell)
         End If
      End If
   End If
   StatusDoFormatoCondicional = Application.Evaluate(FormulaTransformada)

End Function

É isso!

Espero que tenham gostado. Abraços.