Menu
Anterior Seguinte

Como realizar a função contar para dados que estejam com formatação condicional

Fechado
Eliana - 28 jun 2019 às 17:08
Adalberto27 Posts 37 Data de inscrição domingo 9 de junho de 2019 Status Contribuinte Última visita terça 4 de fevereiro de 2020 - 29 jun 2019 às 10:03
boa tarde

Gostaria de aplicar a função de contar pela cor, mas estou utilizando a formatação condicional, olhei alguns posts na internet, mas não consegui entender e nem fazer funcionar. Alguém tem um código em vba que execute essa função?

Grata

Eliana



Configuração: Windows / Chrome 68.0.3440.106

1 Respostas

Resposta 1 / 1
Adalberto27 Posts 37 Data de inscrição domingo 9 de junho de 2019 Status Contribuinte Última visita terça 4 de fevereiro de 2020 15
29 jun 2019 às 10:03
Bom dia Eliana

Num modulo copie e cole os códigos abaixo: 
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


No Módulo da planilha copie e cole o código abaixo: 
Option Explicit

Private Sub Worksheet_SelectionChange(ByVal Target As Range)
    ActiveSheet.Calculate
End Sub


[]s

Assine nossa newsletter!
Assine nossa newsletter!