VBA ( codigo pesquisar e colorir linha )

[tms.guiri]

Bom dia a todos,

Tenho um código VBA ou uma macro, como queiram de pesquisa de palavras em excel. O código esta funcionando perfeitamente, está pesquisando na planilha de forma exata. O que estou com dificuldade de fazer é que ao encontrar determinada palavra, automaticamente seja colorida toda a linha onde se encontra esta palavra e uma linha anterior a ela, porque as informações estão ocupando duas linhas.

O código que estou utilizando para pesquisa é este:

Sub Localiza_palavra_desejada()

sbx = InputBox("Insira no Campo Abaixo o Nome Paciente", "SISTEMA BUSCA DE PACIENTE", "Digite Nome Paciente")

If sbx = cancel Then 'caso cancele a busca

Exit Sub

End If

Cells.Find(What:=sbx, After:=ActiveCell, LookIn:=xlFormulas, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, SearchFormat:=False).Select

MsgBox "O Paciente [ " & sbx & " ] localizado(a)", vbInformation, "SISTEMA BUSCA DE PACIENTE"

End Sub

Agradeço desde já quem puder ajudar.

Edited May 17, 2012 by tms.guiri

[lobismano]

E ai beleza.

Acho que é isso

Cells.Find(What:=sbx, After:=ActiveCell, LookIn:=xlFormulas, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, SearchFormat:=False).Select

linhas = Selection.Row - 1 & ":" & Selection.Row

Rows(linhas).Interior.ColorIndex = 5

at.

[tms.guiri]

Bom dia lobismano,

Muito obrigado, é isso mesmo, so que tem um pequeno problema e não sei se terá como resolver isso. As celulas estão ficando marcadas e não somem depois de outra consulta. Se eu pesquisar por exemplo, 10 vezes, irão ficar os 10 nomes marcados e mesmo se eu fechar o arquivo e abri-lo novamente, continua marcada as linhas. Se tivesse como ao clicar no botão novamente de consulta, as linhas anteriores marcadas apagassem, ficaria show! Mas agradeço porque já me ajudou muito assim, mas se tivesse como fazer isto também, ficaria mais perfeito ainda.

Aguardo resposta novamente e desde já agradeço

Edited May 17, 2012 by tms.guiri

[Dingo]

Bom dia lobismano,

Muito obrigado, é isso mesmo, so que tem um pequeno problema e não sei se terá como resolver isso. As celulas estão ficando marcadas e não somem depois de outra consulta. Se eu pesquisar por exemplo, 10 vezes, irão ficar os 10 nomes marcados e mesmo se eu fechar o arquivo e abri-lo novamente, continua marcada as linhas. Se tivesse como ao clicar no botão novamente de consulta, as linhas anteriores marcadas apagassem, ficaria show! Mas agradeço porque já me ajudou muito assim, mas se tivesse como fazer isto também, ficaria mais perfeito ainda.

Aguardo resposta novamente e desde já agradeço

Crie uma sheet chamada base e outra chamada informações, faça com que a macro exclua a sheet informações copie a base e crie novamente a sheet informações com as informações que estão na sheet base.

Edited May 27, 2012 by Dingo

[tms.guiri]

Bom dia lobismano,

Muito obrigado, é isso mesmo, so que tem um pequeno problema e não sei se terá como resolver isso. As celulas estão ficando marcadas e não somem depois de outra consulta. Se eu pesquisar por exemplo, 10 vezes, irão ficar os 10 nomes marcados e mesmo se eu fechar o arquivo e abri-lo novamente, continua marcada as linhas. Se tivesse como ao clicar no botão novamente de consulta, as linhas anteriores marcadas apagassem, ficaria show! Mas agradeço porque já me ajudou muito assim, mas se tivesse como fazer isto também, ficaria mais perfeito ainda.

Aguardo resposta novamente e desde já agradeço

Crie uma sheet chamada base e outra chamada informações, faça com que a macro exclua a sheet informações copie a base e crie novamente a sheet informações com as informações que estão na sheet base.

Boa tarde Dingo!

Eu ainda estou começando a programar, estou bem leigo ainda e não sei como iria fazer isso. Voce poderia me orientar?

Agradeço desde já e aguardo resposta

[amdahlnperh]

Mas agradeço porque já me ajudou muito assim, mas se tivesse como fazer isto também, ficaria mais perfeito ainda.

[lobismano]

Ai, beleza.

acho que isso resolve.

Cells.Interior.Pattern = xlNone
Cells.find(What:=sbx, After:=ActiveCell, LookIn:=xlFormulas, LookAt _
:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _
False, SearchFormat:=False).Select

linhas = Selection.Row & ":" & Selection.Row
Rows(linhas).Interior.ColorIndex = 5

at.

[Nei Comino]

Mas agradeço porque já me ajudou muito assim, mas se tivesse como fazer isto também, ficaria mais perfeito ainda.

Bom dia.

Veja aí se funciona. Aqui funcionou de boa!!

Sub Localiza_palavra_desejada()

On Error Resume Next

Call Descolorindo

sbx = InputBox("Insira no Campo Abaixo o Nome Paciente", "SISTEMA BUSCA DE PACIENTE", "Digite Nome Paciente")

If sbx = cancel Then 'caso cancele a busca

Exit Sub

End If

Cells.Find(What:=sbx, After:=ActiveCell, LookIn:=xlFormulas, LookAt _

:=xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:= _

False, SearchFormat:=False).Select

linhas = Selection.Row - 1 & ":" & Selection.Row

Rows(linhas).Interior.ColorIndex = 5

If Val(Left(linhas, InStr(linhas, ":") - 1)) > 0 Then

MsgBox "O Paciente [ " & sbx & " ] localizado(a)", vbInformation, "SISTEMA BUSCA DE PACIENTE"

Else

MsgBox "O Paciente [ " & sbx & " ] não foi localizado(a)", vbInformation, "SISTEMA BUSCA DE PACIENTE"

End If

End Sub

Sub Descolorindo()

On Error Resume Next

Cells.Select

With Selection.Interior

.Pattern = xlNone

.TintAndShade = 0

.PatternTintAndShade = 0

End With

Range("A1").Select

End Sub

[Digitador]

ei amdahlnperh

é so você botar:

Rows(linhas).Interior.ColorIndex = 2

depois de :

MsgBox "O Paciente [ " & sbx & " ] localizado(a)", vbInformation, "SISTEMA BUSCA DE PACIENTE"

e assim q você der "ok" na MsgBox, a linha volta a ficar branca novamente..