Fóruns
Microsoft Excel - 2...
2024 - VBA & Macros
Formatação Condicio...
 
Notifications
Clear all

Formatação Condicional Usando VBA

 
2024 - VBA & Macros
8 Posts
3 Usuários
0 Reactions
3,707 Visualizações
RSS
 Anderson Brasiliano
(@andersonbrasiliano)
Posts: 9
Active Member
Topic starter
 

Boa noite pessoal, sou novo no fórum e já procurei por dúvidas semelhantes porém não encontrei.

Tenho uma planilha que faz a contagem de dias trabalhados.

Entre as células A3 até AE3 (A3:AE3) (31 células referente aos 31 dias do mês) vai entrar letras que são E (embarcado), F (folga), B (base), V ou A (férias ou atestado) entre outras e quando entro com essas letras a cor de fundo da célula muda.

Uso no trabalho o Excel 2003 que não me permite fazer mais de 3 Formatações Condicionais.

Abaixo segue o VBA utilizado que somente funciona na célula A3.

--------------

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

If Range("A3") = "F" Or Range("A3") = "" Then
Range("A3").Interior.Color = RGB(255, 255, 255)
End If

If Range("A3") = "E" Then
Range("A3").Interior.Color = RGB(0, 128, 255)
End If

If Range("A3") = "B" Then
Range("A3").Interior.Color = RGB(255, 255, 0)
End If

If Range("A3") = "T" Then
Range("A3").Interior.Color = RGB(0, 255, 255)
End If

If Range("A3") = "TE" Then
Range("A3").Interior.Color = RGB(255, 0, 0)
End If

If Range("A3") = "DS" Then
Range("A3").Interior.Color = RGB(0, 255, 0)
End If

If Range("A3") = "V" Or Range("A3") = "A" Then
Range("A3").Interior.Color = RGB(255, 128, 0)
End If

End Sub

-------------------------

O que necessito é que ao digitar a letra entre o intervalo A3:AE3 mude a cor de fundo da respectiva célula e não somente na célula A3 como no código acima. (O código RGB já esta correto)
Sei que é fácil mas meu conhecimento não vai a fundo nesse momento.

Se alguém puder colar a VBA com a correção ficaria grato

Ex.: Se na célula C3 eu digitar "E" quero que somente a célula C3 mude de cor.
Se na célula H3 eu digitar "B" quero que somente a célula H3 mude de cor.

Entendem? Aguardo ajuda.

 
Postado : 09/08/2013 7:04 pm
 tacito
(@tacito)
Posts: 67
Trusted Member
 

Bom dia!

Veja se este código funciona como você quer.

Private Sub Worksheet_Change(ByVal Target As Range)

If Not Intersect(Target, Range("A3:AE3")) Is Nothing Then

    Dim linha, coluna As Integer
    
    linha = 3
    
    coluna = Target.Column
    
    If Cells(linha, coluna) = "F" Then
        Cells(linha, coluna).Interior.Color = RGB(255, 255, 255)
        
    ElseIf Cells(linha, coluna) = "" Then
        Cells(linha, coluna).Interior.Pattern = xlNone
        
    ElseIf Cells(linha, coluna) = "E" Then
        Cells(linha, coluna).Interior.Color = RGB(0, 128, 255)
    
    ElseIf Cells(linha, coluna) = "B" Then
        Cells(linha, coluna).Interior.Color = RGB(255, 255, 0)
        
    ElseIf Cells(linha, coluna) = "T" Then
        Cells(linha, coluna).Interior.Color = RGB(0, 255, 255)
        
    ElseIf Cells(linha, coluna) = "TE" Then
        Cells(linha, coluna).Interior.Color = RGB(255, 0, 0)
        
    ElseIf Cells(linha, coluna) = "DS" Then
        Cells(linha, coluna).Interior.Color = RGB(0, 255, 0)
    
    ElseIf Cells(linha, coluna) = "V" Or Range("A3") = "A" Then
        Cells(linha, coluna).Interior.Color = RGB(255, 128, 0)
    End If

End If

End Sub
 
Postado : 10/08/2013 4:43 am
 Anderson Brasiliano
(@andersonbrasiliano)
Posts: 9
Active Member
Topic starter
 

tacito, Muito obrigado pela ajuda porém ainda não funcionou.
Entendi sua mecânica porém acredito que ainda deve haver algum erro.

Continuarei tentando, mediante seu modelo, outras formas de macro para obter sucesso e enquanto isso continuo aguardando uma ajuda.

 
Postado : 10/08/2013 5:35 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa arde!!

Faça os teste

Por favor os arquivos devem ser compactados, é regra do fórum!!!

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 10/08/2013 11:37 am
 Anderson Brasiliano
(@andersonbrasiliano)
Posts: 9
Active Member
Topic starter
 

alexandrevba, primeiramente desculpa pela parte da compactação, errei e isso serve como lição aprendida.

Agora venho agradecer também pela ajuda. Você fez da forma que eu queria realizando a mudança de cor nas células que receberiam as letras em todas as 4 planilhas.

Você criou um módulo (ColorirAleVBA_8974) e ele é chamado toda em todas as planilhas, o que facilita muito o trabalho ao invés de digitar toda a função em cada planilha, como eu faria rs.

Há a mudança de cor, porém para ela acontecer eu tenho que mudar para outra planilha e depois voltar a ela. Muito estranho.
Saberia me dizer o porque?
Irei marcar como resolvido, pois ela faz o que eu necessito, porém somente como esse ressalto.

 
Postado : 10/08/2013 11:15 pm
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Contribuindo, o reportado acontece pois a execução da macro está condicionada ao evento activate da planilha.
Voce pode alterar todos os eventos para o change ou Calculate de cada planilha ou (eu prefiro) incluir a rotina abaixo no modulo "ThisWorkbook" ou "Pasta de Trabalho", assim em cada alteração de uma planilha (ou sheet) irá executar erra rotina.

Private Sub Workbook_SheetCalculate(ByVal Sh As Object)
    ColorirAleVBA_8974
End Sub

Obs.: as rotinas em cada sheet pode ser apagada

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/08/2013 6:12 am
Fernando Fernandes
 Fernando Fernandes
(@fernandofernandes)
Posts: 43750
Illustrious Member
 

Boa tarde!!

Com essa dica do Reinaldo, deve resolver seu problema.

Att

Existem mil maneiras de preparar Neston. Invente a sua!
http://www.youtube.com/ExpressoExcel

 
Postado : 11/08/2013 9:29 am
 Anderson Brasiliano
(@andersonbrasiliano)
Posts: 9
Active Member
Topic starter
 

Reinaldo... Simplesmente perfeito!

Obrigado a ajuda de todos.

:D :P :lol:

 
Postado : 11/08/2013 7:26 pm
Forum Jump:
  Tópico Anterior
Próximo Tópico