Novo
 Comunidade

Fazendo soma por ColorFunction automático

  Excel
MrRemodel
  MrRemodel
  Quinta-feira, 05 2023 janeiro
  1 Respostas
  3.6 mil visitas
0
Votos
desfazer
Agradecemos antecipadamente por qualquer ajuda sobre isso que você pode oferecer.

Com a ajuda deste site criei a seguinte função;

Function ColorFunction(rColor As Range, rRange As Range, Opcional SUM As Boolean)
Dim rCell como intervalo
Dim lCol enquanto
Dim vResultado
lCol = rColor.Interior.ColorIndex
Se SOMA = Verdadeiro Então
Para cada rCell em rRange
Se rCell.Interior.ColorIndex = lCol Então
vResult = WorksheetFunction.SUM(rCell, vResult)
Se acabar
Próximo rCell
Outro
Para cada rCell em rRange
Se rCell.Interior.ColorIndex = lCol Então
vResultado = 1 + vResultado
Se acabar
Próximo rCell
Se acabar
ColorFunction = vResultado
Função final


Em cada célula de destino que desejo uma soma de todas as células nessa linha que contêm a cor da célula especificada;
=função de cor(AR4,H5:AP5,TRUE)

Como posso atualizar a venda de destino quando qualquer outra célula na linha (H5:AP5) muda de cor?
0
Mais velhos primeiro  
Amanda Lee
Amanda Lee
1 ano atrás
·
#3338
0
Votos
desfazer
Oi lá,

Você pode adicionar o código: Aplicativo.Cálculo = xlAutomatic para sua função:

Function ColorFunction(rColor As Range, rRange As Range, Optional SUM As Boolean)

Dim rCell As Range

Dim lCol As Long

Dim vResult

Application.Calculation = xlAutomatic

lCol = rColor.Interior.ColorIndex

If SUM = True Then

For Each rCell In rRange

If rCell.Interior.ColorIndex = lCol Then

vResult = WorksheetFunction.SUM(rCell, vResult)

End If

Next rCell

Else

For Each rCell In rRange

If rCell.Interior.ColorIndex = lCol Then

vResult = 1 + vResult

End If

Next rCell

End If

ColorFunction = vResult

End Function


Por favor, tente.

Amanda
  • Página :
  • 1
Ainda não há respostas para esta postagem.