Este fórum está sendo desativado

[becerqueiraa]

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

[Foxtri]

Bom dia
Neste endereço existe uma opção para a sua avaliação.
https://techcommunity.microsoft.com/t5/ ... /m-p/36495
Até
Foxtri

[osvaldomp]

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

[LionHenry]

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

[BOJANOVSKI]

Bom dia!

Sou novo no forum e estou precisando de ajuda, não domino VBA, conheço apenas o basico, tenho uma planilha que necessito contas as celulas que estão em vermelho, elas ficam em vermelho em decorrência de uma formatação condicional, consegue um modelo do forum e tentei adaptar a minha necessidade más sempre ocorre erro.
Abusando, poderiam analisar em me dizer o que estou errando?
Segue planilha

[osvaldomp]

Olá, @BOJANOVSKI .

Segue uma alternativa, veja se aproveita.
Instale uma cópia do código abaixo no módulo da planilha PESOS. Para acessar o módulo clique com o direito na guia daquela planilha e escolha Exibir Código.

Código: Selecionar todos

Private Sub Worksheet_Change(ByVal Target As Range)
 Dim k As Long, x As Long, c As Long
  If Intersect([B5:U14], Target) Is Nothing Then Exit Sub
  For k = 22 To 32
   For x = 5 To 14
    If Application.CountIf(Cells(x, 2).Resize(, 20), Cells(x, k)) Then c = c + 1
   Next x
   Cells(3, k) = c: c = 0
  Next k
End Sub

#
funcionamento - após alterar manualmente qualquer célula no intervalo B5:U14 o código irá atualizar todas as contagens; resultados em V3:AF3.
#
obs. o código acima é o suficiente para o que você deseja, e não precisa de nenhum dos seus códigos existentes.

[BOJANOVSKI]

Osvaldo, boa tarde!
Imensamente grato pelo sua presteza, gentileza e atenção!
Fiz a inclusão em um novo modulo da planilha, contudo, continua dando o erro, acredito pela falta de conhecimento em VBA estou cometendo algum equivoco, abusando do amigo, você teria como alterar na planilha que enviei e devolve-la me, até para que eu possa analisar e verificar o erro que estou cometendo pois tentei 5 vezes e continua dando o mesmo erro.
Grato
Bojanovski

[osvaldomp]

Olá, @BOJANOVSKI .

Melhor seria se você disponibilizar novamente o seu arquivo com o código que passei instalado, informe qual o erro e em que circunstâncias ele ocorre.

[BOJANOVSKI]

Bom dia! @osvaldomp

Osvaldo, desculpe-me a ausência de resposta, tive problemas com a bendita Covid, más já estou +-novo em folha.

Não consegui enviar a planilha pois fiquei fora do ar, segue a planilha que deu o erro, coloquei a função que você corrigir más continuou o erro, se puder fazer a gentileza de analisar e verificar o que errei agradeço imensamente.

Abraço

[osvaldomp]

Olá, @BOJANOVSKI .

Espero que você esteja bem da Covid.

Você colou uma cópia do código que passei no Módulo3 e outra no Módulo4 e desativou ambas. Mesmo que estivessem ativas essas cópias não iriam produzir resultados se instaladas em módulos comuns.

Por se tratar de um código que é disparado por um evento de planilha, então, conforme comentei antes (post 66629), o código deve ser instalado no módulo da planilha PESOS e não em um módulo comum.

"Instale uma cópia do código abaixo no módulo da planilha PESOS. Para acessar o módulo clique com o direito na guia daquela planilha e escolha Exibir Código."

Após escolher Exibir Código, irá se abrir a janela correspondente ao módulo daquela planilha, aí cole o código nessa janela. Essa é a manobra necessária. Em seguida feche o editor de VBA e faça os testes.

[BOJANOVSKI]

Boa tarde! @osvaldomp

Estou melhor, más na fisio ainda... respiração um pouco ruim... más melhorando.

Vou tentar fazer como orientou, agradeço imensamente a gentileza e atenção.

Abração