Guru do Excel e Power BI

Option Explicit

Public Function CFColorindex(rng As Range)
Dim oFC As FormatCondition
Dim sF1 As String
Dim iRow As Long
Dim iColumn As Long

   If rng.FormatConditions.Count > 0 Then
      For Each oFC In rng.FormatConditions
         If oFC.Type = xlCellValue Then
            Select Case oFC.Operator
               Case xlEqual
                  CFColorindex = rng.Value = oFC.Formula1
               Case xlNotEqual
                  CFColorindex = rng.Value <> oFC.Formula1
               Case xlGreater
                  CFColorindex = rng.Value > oFC.Formula1
               Case xlGreaterEqual
                  CFColorindex = rng.Value >= oFC.Formula1
               Case xlLess
                  CFColorindex = rng.Value < oFC.Formula1
               Case xlLessEqual
                  CFColorindex = rng.Value <= oFC.Formula1
               Case xlBetween
                  CFColorindex = (rng.Value >= oFC.Formula1 And _
                             rng.Value <= oFC.Formula2)
               Case xlNotBetween
                  CFColorindex = (rng.Value < oFC.Formula1 Or _
                             rng.Value > oFC.Formula2)
            End Select
         Else
            With Application
               iRow = rng.Row
               iColumn = rng.Column
               sF1 = .Substitute(oFC.Formula1, "LIN()", iRow)
               sF1 = .Substitute(sF1, "COL()", iColumn)
               sF1 = .ConvertFormula(sF1, xlA1, xlR1C1, , oFC.AppliesTo.Cells(1))
               sF1 = .ConvertFormula(sF1, xlR1C1, xlA1, , rng)
            End With
            CFColorindex = rng.Parent.Evaluate(sF1)
         End If
         If CFColorindex Then
            If Not IsNull(oFC.Interior.ColorIndex) Then
               CFColorindex = oFC.Interior.ColorIndex
               Exit Function
            End If
         End If
     Next oFC
   End If

End Function

Function SumByCFColorIndex(rng As Range, CI As Integer) As Double
    Dim R As Range
    Dim Total As Double
    For Each R In rng.Cells
        If CFColorindex(R) = CI Then
            Total = Total + R.Value
        End If
    Next R
    SumByCFColorIndex = Total
End Function

Function CountByCFColorIndex(rng As Range, CI As Integer) As Double
    Dim R As Range
    Dim Total As Long
    For Each R In rng.Cells
        If CFColorindex(R) = CI Then
            Total = Total + 1
        End If
    Next R
    CountByCFColorIndex = Total
End Function

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

Application.Volatile
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
      'Caso a formatação condicional seja uma fórmula
      FormulaTransformada = FormatCondition.Formula1
      FormulaTransformada = Replace(FormulaTransformada, ";", ",")
      
      'Traduzindo a função SE para o inglês
      FormulaTransformada = Replace(FormulaTransformada, "SE(", "IF(")
      
      'Adicione traduções para as funções que você usar
      'Exemplos:
      'FormulaTransformada = Replace(FormulaTransformada, "MÉDIA(", "AVERAGE(")
      'FormulaTransformada = Replace(FormulaTransformada, "SOMA(", "SUM(")
      'FormulaTransformada = Replace(FormulaTransformada, "SOMASE(", "SUMIF(")
      
      FormulaTransformada = Application.ConvertFormula(FormulaTransformada, xlA1, xlR1C1, xlRelative, FormatCondition.AppliesTo.Resize(1, 1))
      FormulaTransformada = Application.ConvertFormula(FormulaTransformada, xlR1C1, xlA1, xlRelative, Cell)
   End If
   StatusDoFormatoCondicional = Application.Evaluate(FormulaTransformada)

End Function