Busca em planilha com VBA

[Hugo Naves]

Pessoal, bom dia.

Estou com dúvidas em como elaborar uma macro que me retornem todas as células que contenham um determinado valor.

Eu encontrei o seguinte código onde procura o valor em um determinado intervalo, mas me retorna somente 1 linha.

Eu preciso que retornem TODAS as linhas que tenham o valor descrito.

Código de busca: Range("A:A").Find(what:="Carlos", after:=ActiveCell, lookat:=xlPart).Activate

Supondo que esta seja a planilha:

Nome Sergio Carlos Dourado Zilda Conceicao de Brito Hirasawa Luiz Fernando da Motta Fernanda de Azevedo e Silva Carlos Eduardo de Oliveira

O código deve me trazer a linha 2 e 6.

Obrigado!!!

[Marcoseb51]

Bom dia,

Tenho um problema semelhante ao seu, tenho um controle de consumo de combustível, km rodado, valor gasto, etc, em uma planilha. Preciso usar o vba para pesquisar cada placa na planilha e que copie o valor de 5 colunas em outra planilha.

Cada veículo abastece varias vezes no mês, tenho que calcular a média para Km rodado, valor em R$ gasto, e quanto em combustível foi usado, você conseguiu a resposta ou solucionar seu problema?

Poderia me ajudar?

Obrigado

[Ricardolaf]

Amigo,

Fiz uma função que pode te ajudar.

Seria melhor ao invés de selecionar uma coluna inteira (por que gasta mais processamento), você deveria selecionar um Range, tipo do A1 ao A (ultima linha preenchida) por exemplo.

Function Buscar(Valor As String, coluna As String)

' Declaração das Variáveis
Dim rng As Variant
Dim linhas As String
Dim cont As Long
Dim bool As Boolean

' Inialização das Variáveis
bool = False
cont = 1

' Define o range
rng = ThisWorkbook.Sheets("Plan1").Columns(coluna)

' Texto inicial
linhas = "Linhas Encontradas para o item " & "[" & Valor & "]" & vbCrLf & vbCrLf

' Loop no range
For Each y In rng

' Caso haja alguma combinação
If InStr(1, y, Valor, vbBinaryCompare) > 0 Then

' Preenche o texto inicial com a linha atual
linhas = linhas & "Linha " & cont & vbCrLf

' Indica que pelo menos um valor foi encontrado
bool = True
End If
cont = cont + 1
Next

' Se pelo menos um valor foi encontrado
If bool = True Then

' mensagem com as linhas encontradas
Buscar = linhas
Else

' Senão retorna mensagem sem registro
Buscar = "Nenhum Registro Encontrado !"
End If

End Function


Sub Valor()
MsgBox Buscar("Carlos", "A:A")
End Sub

espero ter ajudado.

At.

Ricardo.

http://xlssolution.blogspot.com.br/

[EMSO.EXE]

consegui desta forma

Private Sub btn_consulta_desc_Click()

Dim coluna(31) As String
Dim y, i, k As Integer
y = 7

Sheets("consulta").Select
Range("B4").Select
pesquisa = ActiveCell.FormulaR1C1

    If pesquisa = "" Then Exit Sub
    Set plan = Sheets("dados")
    Set x = plan.Columns("A:A").Find(what:=pesquisa)
    If Not x Is Nothing Then
      celula = x.Address
      Do
        plan.Select
        x.Select
        Selection.Copy
        For i = 1 To 31
            coluna(i) = x.Columns(i)
        Next i
        Sheets("consulta").Select
        Range("A" & y).Value = coluna(1)
        Range("B" & y).Value = coluna(2)
        Range("C" & y).Value = coluna(3)
        Range("D" & y).Value = coluna(4)
        Range("E" & y).Value = coluna(5)
        Range("F" & y).Value = coluna(7)
        Range("G" & y).Value = coluna(12)
        Range("H" & y).Value = coluna(14)
        Range("I" & y).Value = coluna(15)
        Range("J" & y).Value = coluna(16)
        Range("K" & y).Value = coluna(17)
        Range("L" & y).Value = coluna(18)
        Range("M" & y).Value = coluna(19)
        Range("N" & y).Value = coluna(21)
        Range("O" & y).Value = coluna(22)
        Range("P" & y).Value = coluna(23)
        Range("Q" & y).Value = coluna(24)
        Range("R" & y).Value = coluna(25)
        Range("S" & y).Value = coluna(26)
        Range("T" & y).Value = coluna(30)
        Range("U" & y).Value = coluna(31)
              
        y = y + 1
        
        Set x = plan.Columns("A:A").FindNext(x)
      Loop While Not x Is Nothing And x.Address <> celula
    Else
      MsgBox "Produto " & pesquisa & " não encontrado na planilha " & plan.Name
    End If

End Sub