Somar a cor de um intervalo

[The Lau]

Boa tarde a todos... Agradeço antecipadamente a ajuda!

Tenho uma coluna com vários valores no intervalo (a12:a54)

122

22

44

55

66

66

Gostaria de uma macro que somasse a cor vermelha, dentro do intervalo determinado acima.

O resultado pode ser colocado em "A10".

Obrigado a todos.

Achei este procedimento em outro forum mas não sei fazer os ajustes... Ainda mais que gostaria que fosse automático!!

Function SOMACOR(qRange As Range, ByVal qCor$) As Double
Dim c As Range, xcolor&, xvalue#

Select Case qCor$
Case "VERMELHO"
xcolor& = 255
Case "PRETO"
xcolor& = 0
Case "AZUL"
xcolor& = RGB(0, 0, 255)
Case "VERDE"
xcolor& = RGB(0, 255, 0)
Case "AMARELO"
xcolor& = RGB(255, 255, 0)
Case "ROSA"
xcolor& = RGB(255, 0, 255)
'Case "isto é apenas um comentário, para adicionar cores aqui, coloque o nome da cor aqui e retire o ' do começo da linha"
' xcolor& = isto é apenas um comentário, para adicionar cores aqui, coloque o código RGB da cor correspondente aqui e retire o ' do começo da linha
End Select

For Each c In qRange
If c.Font.Color = xcolor Then
xvalue# = xvalue# + c.Value
End If
Next

SOMACOR = xvalue#
End Function

Até +

[Paulo H Grando]

Você pode utilizar um loop For Each para "varrer" a coluna e realizar a soma quando encontrar uma célula com a cor vermelha. É praticamente igual ao que você encontrou em outro fórum, mas com os seus parâmetros.

Sub SomaCor()
Dim Soma As Integer

Soma = 0
For Each cell In Range("A12:A54")
     If cell.Font.ColorIndex = 3 Then
           Soma = Soma + cell.Value
     End If
Next cell

Range("A10").Value = Soma

End Sub

Esse procedimento soma especificamente a cor vermelha e apenas no intervalo especificado. Se a cor ou o intervalo mudam, o ideal é ter um pequeno formulário para entrada do intervalo e da cor desejada.

[The Lau]

Você pode utilizar um loop For Each para "varrer" a coluna e realizar a soma quando encontrar uma célula com a cor vermelha. É praticamente igual ao que você encontrou em outro fórum, mas com os seus parâmetros.

Sub SomaCor()
Dim Soma As Integer

Soma = 0
For Each cell In Range("A12:A54")
     If cell.Font.ColorIndex = 3 Then
           Soma = Soma + cell.Value
     End If
Next cell

Range("A10").Value = Soma

End Sub

Esse procedimento soma especificamente a cor vermelha e apenas no intervalo especificado. Se a cor ou o intervalo mudam, o ideal é ter um pequeno formulário para entrada do intervalo e da cor desejada.

Boa Noite!

Agradeço a ajuda mais ainda tenho uma dúvida.

Nesta soma o resultado esta sendo arredondado e como estou lidando com valores financeiros isso dá problemas... E aproveitando o ensejo... Como intercalar com mais um intervalo?

[Paulo H Grando]

Para tratar a questão dos valores financeiros basta mudar o tipo da variável Soma de Integer para Float. Sobre um intervalo adicional, você pode copiar o bloco For Each...Next para antes da linha que passa o valor da Soma para a celula A10 e mudar o Range no início do loop.

[The Lau]

Obrigado Paulo!

Deu certo e agora só alegria!

Um abraço!

Att

[Paulo H Grando]

The Lau,

Andei pensando na macro que você está utilizando e me ocorreu que talvez seja mais fácil usar uma fórmula para fazer a soma das células. Qual o motivo que leva a fonte da célula a ser pintada de vermelho? Você está usando formatação condicional? Se sim, qual a condição?

Muitas vezes é mais fácil e prático usar uma fórmula.

Editado Setembro 30, 2009 por Paulo H Grando

[The Lau]

The Lau,

Andei pensando na macro que você está utilizando e me ocorreu que talvez seja mais fácil usar uma fórmula para fazer a soma das células. Qual o motivo que leva a fonte da célula a ser pintada de vermelho? Você está usando formatação condicional? Se sim, qual a condição?

Muitas vezes é mais fácil e prático usar uma fórmula.

Boa Noite

Desculpe a demora...

É o seguinte este macro esta sendo utilizado num livro caixa... Tem doze meses...

Então cada cor corresponde a uma classificação da nota... São 9 cores!

MATERIAL DE EXPEDIENTE

DIDÁTICO PEDAGÓGICO

MATERIAL DE LIMPEZA

MATERIAL ELETRICO E HIDRÁULICO

EMERGÊNCIA MÉDICA

OUTROS

MANUTENÇÃO DE MÁQUINAS EQUIPAMENTOS

CONSERVAÇÃO E porque REPAROS DE BENS MÓVEIS

OUTROS

Fiz um form para colocar as cores e a sua macro para calcular...

Até agora está tudo funcionando bem...

Acredito que não precise alterar...