Ir ao conteúdo
  • Cadastre-se
Sandra Vasquez

Excel Apenas colorir parte do texto na mesma célula

Posts recomendados

Bom dia,

 

Eu já tentei criar uma formatação no VBA para colorir apenas parte do texto da célula , mas não está funcionando muito bem

 

Tem um tópico parecido aqui no fórum   , mas o que eu preciso acredito ser um pouco diferente, mas com o mesmo conceito.

 

Exemplo:  tem alguns padrões de texto especifico na mesma célula , que gostaria de colorir.

 

Coluna A , Range 1 a 40

 

Texto a colorir:  Tubo1 ; Tubo2 ; Tubo3  até Tubo40     Cor Verde

                         Caixa1; Caixa2; Caixa3 até Caixa40  Cor Amarelo

                         pacote1;pacote2 até pacote40            Cor Azul

 

Enfim, exemplo:

 

Coluna A célula na linha 1 texto na mesma célula : Tubo 1 Caixa 2  Pacote 3 ( pintar (tubo1) verde ; pintar (tCaixa2) amarelo ;pintar (pacote3 ) azul)

Coluna A célula na linha 2 texto na mesma célula : Tubo 5 Caixa 10  Pacote 30 ( pintar (tubo5) verde ; pintar (Caixa10) amarelo ;pintar (pacote30) azul)

Enfim , da coluna A range de 1 a 40 , pintar conforme o texto especifico , e caso não contenha nenhum desses texto , não pintar.

                      

 

Alguém consegue me ajudar?

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bom dia! Achei esse link na internet, acho que resolve seu problema:

 

https://stackoverflow.com/questions/30567552/change-font-color-for-a-part-of-text-in-cell

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites

 

Experimente:

 


 

Sub PintaFonte()
 Dim k As Long, v As Long, c As Range
  For Each c In Range("A1:A" & Cells(Rows.Count, 1).End(3).Row)
   k = InStr(1, c.Value, "Tubo")
   If k > 0 Then
    v = InStr(k + 5, c.Value, " ")
     c.Characters(k, v - k).Font.Color = vbGreen
   End If
   k = InStr(1, c.Value, "Caixa")
   If k > 0 Then
    v = InStr(k + 6, c.Value, " ")
     c.Characters(k, v - k).Font.Color = vbRed 'vbYellow
   End If
   k = InStr(1, c.Value, "Pacote")
   If k > 0 Then
    v = InStr(k + 7, c.Value, " ")
     c.Characters(k, v - k).Font.Color = vbBlue
   End If
  Next c
End Sub

 

  • Curtir 4

Compartilhar este post


Link para o post
Compartilhar em outros sites

Bem vinda ao fórum, @Sandra Vasquez

 

Aqui vai mais uma:

Option Compare Text
Sub PintarTexto()
 Dim cél As Range, m As Object
 With CreateObject("VBScript.RegExp")
   .Pattern = "((Tubo|Caixa|Pacote)\s*\d+)": .IgnoreCase = True: .Global = True: .MultiLine = True
   For Each cél In [A1:A40].Cells
     For Each m In .Execute(cél.Value)
       cél.Characters(m.FirstIndex + 1, m.Length).Font.Color = Switch(m.SubMatches(1) = "Tubo", vbGreen, _
                                                                      m.SubMatches(1) = "Caixa", vbYellow, _
                                                                      m.SubMatches(1) = "Pacote", vbBlue)
     Next m
   Next cél
 End With
End Sub

Obs.: O código intercepta a ocorrência de algum dos textos-chave (Tubo/Caixa/Pacote) seguidos ou não de espaço(s) em branco e seguidos de pelo menos um algarismo. Se o padrão for outro, nos avise, ok?

  • Curtir 4

Compartilhar este post


Link para o post
Compartilhar em outros sites
8 minutos atrás, Edson Luiz Branco disse:

Bem vinda ao fórum, @Sandra Vasquez

 

Obs.: O código intercepta a ocorrência de algum dos textos-chave (Tubo/Caixa/Pacote) seguidos ou não de espaço(s) em branco e seguidos de pelo menos um algarismo. Se o padrão for outro, nos avise, ok?

 

Nossa , já testei seu código , muito bom , curto , mais eficaz, e eu rachando a cabeça aqui , obrigada mesmo.

adicionado 3 minutos depois
1 hora atrás, osvaldomp disse:

 

Experimente:

 

 

 

O código do Edson funcionou , mas mesmo assim vou testar o seu também viu.

 

Agradeço muito , pela rapidez da resposta , não sabia que era tão rápido assim , achei que ia demorar uma vida para solucionar meu problema kkk

  • Curtir 1

Compartilhar este post


Link para o post
Compartilhar em outros sites
Em 27/02/2020 às 11:00, Edson Luiz Branco disse:

Bem vinda ao fórum, @Sandra Vasquez

 

Aqui vai mais uma:

Obs.: O código intercepta a ocorrência de algum dos textos-chave (Tubo/Caixa/Pacote) seguidos ou não de espaço(s) em branco e seguidos de pelo menos um algarismo. Se o padrão for outro, nos avise, ok?

 

Edson, seu código está funcionando perfeitamente , mas na minha planilha eu uso concatenar para puxar esses dados para minha coluna , e quando executo seu código , acaba pintando tudo na mesma cor , exemplo se na célula usando concatenar aparece tudo e caixa , ele pinta tudo da mesma cor , ai testei colocar os textos em usar concatenar , ai funciona , mas se usar o concatenar , pinta tudo na mesma cor , tem como acertar isso ? porque tem muitos dados, e preciso puxar com concatenar  , se puder ajudar , agradeço. obrigada

Compartilhar este post


Link para o post
Compartilhar em outros sites

Sandra, anexe aqui um arquivo com alguns exemplos disso, pois fica mais fácil trabalhar direto em cima de seu modelo.

Obs.: se for .xlsm tem que zipar pra poder anexar aqui no fórum.

Compartilhar este post


Link para o post
Compartilhar em outros sites
22 horas atrás, Edson Luiz Branco disse:

Sandra, anexe aqui um arquivo com alguns exemplos disso, pois fica mais fácil trabalhar direto em cima de seu modelo.

Obs.: se for .xlsm tem que zipar pra poder anexar aqui no fórum.

Fiz um exemplo , demorei porque estou tento problemas o excel agora começou a dar aviso de compartilhamento , e apaga minha planilhas e o windows não estava deixando eu zipar nenhuma pasta com macro .

Pasta1.rar

Compartilhar este post


Link para o post
Compartilhar em outros sites

Ok, Sandra, entendi.

 

Mas infelizmente não é possível mudar individualmente a cor de caracteres quando oriundos de resultado de alguma fórmula naquela célula: ou muda tudo ou nada.

 

A boa notícia é que há várias formas de conseguir o mesmo resultado via VBA. Um deles seria você fazer a concatenação não via fórmula mas direto no código.

 

A outra, mais imediata, é destruir a fórmula de concatenação ficando só com o valor dela na célula, aí seria só inserir uma instrução no código que te passei acima (ou também poderia ser com Copiar/Colar Valores) :

Sub PintarTexto()
 Dim cél As Range, m As Object
 With CreateObject("VBScript.RegExp")
   .Pattern = "((Tubo|Caixa|Pacote)\s*\d+)": .IgnoreCase = True: .Global = True: .MultiLine = True
   For Each cél In [A1:A40].Cells
     cél.Value = cél.Value '<====Insira essa instrução
     For Each m In .Execute(cél.Value)
       cél.Characters(m.FirstIndex + 1, m.Length).Font.Color = Switch(m.SubMatches(1) = "Tubo", vbGreen, _
                                                                      m.SubMatches(1) = "Caixa", vbYellow, _
                                                                      m.SubMatches(1) = "Pacote", vbBlue)
     Next m
   Next cél
 End With
End Sub

 

De qualquer maneira, você só obterá o efeito desejado quando não houver fórmula na célula.

Compartilhar este post


Link para o post
Compartilhar em outros sites
2 horas atrás, Edson Luiz Branco disse:

Ok, Sandra, entendi.

 

Mas infelizmente não é possível mudar individualmente a cor de caracteres quando oriundos de resultado de alguma fórmula naquela célula: ou muda tudo ou nada.

 

A boa notícia é que há várias formas de conseguir o mesmo resultado via VBA. Um deles seria você fazer a concatenação não via fórmula mas direto no código.

 

A outra, mais imediata, é destruir a fórmula de concatenação ficando só com o valor dela na célula, aí seria só inserir uma instrução no código que te passei acima (ou também poderia ser com Copiar/Colar Valores) :

 

De qualquer maneira, você só obterá o efeito desejado quando não houver fórmula na célula.

 

Obrigado Edson.

Compartilhar este post


Link para o post
Compartilhar em outros sites

Crie uma conta ou entre para comentar

Você precisar ser um membro para fazer um comentário

Criar uma conta

Crie uma nova conta em nossa comunidade. É fácil!

Crie uma nova conta

Entrar

Já tem uma conta? Faça o login.

Entrar agora





Sobre o Clube do Hardware

No ar desde 1996, o Clube do Hardware é uma das maiores, mais antigas e mais respeitadas publicações sobre tecnologia do Brasil. Leia mais

Direitos autorais

Não permitimos a cópia ou reprodução do conteúdo do nosso site, fórum, newsletters e redes sociais, mesmo citando-se a fonte. Leia mais

×
×
  • Criar novo...

Redes de Computadores - Gabriel Torres

PROMOÇÃO DE QUARENTENA

De R$ 39,90 por apenas R$ 9,90 só até as 23h59min desta sexta-feira 03/04/2020

CLIQUE AQUI E COMPRE AGORA MESMO!