Tópicos relacionados a códigos VBA, gravação de macros, etc.
  • Avatar do usuário
#60644
Amigos,
Preciso da ajuda de alguém que conheça bem sobre VBA, encontrei uma programação que permite criar uma função que conta as células coloridas pela formatação condicional em um determinado intervalo.
=ContaCelulaColoridaFormatCond(D5;J8:AM19)

Onde d5 está com a cor ( verde)
J8:AM19 é o intervalo onde estão os valores com formatação condicional com formula e com data

neste exemplo temos 22 casas no intervalo, cada uma tem uma formula que corresponde a um filtro, se o valor da célula se encaixa na estatística a célula fica verde, neste caso quero usar a fórmula =ContaCelulaColoridaFormatCond(D5;J8:AM19) para contar quantas células ficaram verdes no intervalo.

Porém quando aplico a fórmula #valor

Preciso descobrir o erro na programação para que a fórmula conte todas as células coloridas pela formatação condicional no intervalo. Minha intenção é descobrir como fazer o macro rodar nas condições da minha planilha.

segue abaixo o código VBA completo e em anexo a planilha para melhor entendimento


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(", "AVG(")
'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

Sub Contacor()

End Sub
Imagem
Você não está autorizado a ver ou baixar esse anexo.
#60786
becerqueiraa escreveu: 19 Nov 2020 às 13:13 Preciso da ajuda de alguém que conheça bem sobre VBA, :?: :?: :?:
Considerando o primeiro arquivo disponibilizado no seu post:

Plan1 ~~~> em A6 não está aplicada a Formatação Condicional e a cor em D6 é diferente de todas as cores aplicadas na Formatação Condicional na coluna A; corrigidos esses dois pontos a contagem em E6:E9 deverá indicar 8, 9 e 12 para preto,azul e vermelho respectivamente.
Para atualizar a contagem a cada vez que houver uma alteração manual na coluna A instale uma cópia do código abaixo no módulo da Plan1 no lugar do código lá existente. Funciona para qualquer quantidade de células com FC na coluna A e não utiliza as Funtions existentes no seu arquivo que podem ser excluídas.
Código: Selecionar todos
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Column > 1 Then Exit Sub
 Dim c As Range, k As Long
  [E6:E9] = ""
  For Each c In Range("A2:A" & Cells(Rows.Count, 1).End(3).Row)
   Select Case c.DisplayFormat.Interior.Color
    Case 0: k = 6 'preto
    Case 8388608: k = 7 'azul
    Case 255: k = 8 'vermelho
    Case 52479: k = 9 'ocre
   End Select
   Cells(k, 5) = Cells(k, 5) + 1
  Next c
End Sub


Planilha1 ~~~> para contar as células verdes no intervalo J8:AM19 é suficiente a fórmula =SOMA(E8:E19) em J20. A propósito, se a duração inclui as datas de início e de fim então você precisa acrescentar 1 às fórmula da coluna E ~~~> =G8-F8+1
#63662
Bom dia!

No ficheiro "Indicadores de Cronograma.xlsm", para a parte que não está a dar para contar (formula em J20), encontrei uma solução no site http://www.cpearson.com/Excel/CFColors.htm, mas os meus conhecimentos de VBA não me estão a ajudar a conseguir por este código a funcionar. Preciso da vossa AJUDA.

A solução que já foi apresentada, que remete para o site https://techcommunity.microsoft.com/t5/ ... /m-p/36495 não dá para aplicar no J20, pois a formatação condicional tem formula mas não tem referência.

Agradeço toda a vossa AJUDA!

Gracias

Olá galera, Estou tentando criar um gr&aac[…]

FUNÇÃO SOMESES

Na planilha a1, TOKO tem um espaço antes da[…]

osvaldomp, muito agradecido pela ajuda :D :D

Não entendi se sua dúvida é d[…]

Cadastro de Funcionários

Eu não me proponho a construir o UserForm d[…]

MONGO DB

https://docs.mongodb.com/bi-connector/master/tuto[…]

Mudar o mês na fórmula 2

boa noite, a fórmula vai depender de onde […]

Definição Tamanho da Célula

boa tarde supondo que o nome esta na B3, vc pode f[…]