none
Pesquisar em várias planilhas e lançar os dados em list box com hiperlink para a célula que contem o valor pesquisado RRS feed

  • Pergunta

  • Boa tarde!

    Tenho uma planilha onde estão listados vários caminhos para arquivos dentro do computador.

    Preciso criar uma macro que procure determinada palavra (dentro de um nome de arquivo) ao longo de toda a pasta de trabalho, liste em uma listbox todas os nomes de arquivos encontrados e que quando eu clicar no arquivo dentro da lsitbox ele me leve ao local na planilha onde está o nome listado.

    É possível?

    Att,

    SahTL

    sexta-feira, 26 de junho de 2015 17:32

Respostas

  • Crie um userform com um listbox grande onde serão listados os resultados (listbox1), um CommandButton que será o botão para chamar a pesquisa (CommandButton1) e um textbox que é onde será inserido o texto a ser pesquisado (Textbox1).

    Aplique o código abaixo no módulo do userform:

    Private Sub CommandButton1_Click()
    
     Dim bErro As Boolean
        Dim sProcura As String
        Dim Sheet As Worksheet
        Dim sAddr As String
        Dim bAddr
        Dim rcell As Range
        
        ListBox1.Clear
        
        bErro = False
        sProcura = TextBox1
        
        For Each Sheet In ActiveWorkbook.Sheets
            
            bAddr = True
            bErro = False
            Sheet.Activate
            Excel.Range("A1").Activate
            
            Do Until bErro = True
                
                On Error GoTo erro
                
                Set rcell = Cells.Find(What:=sProcura, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                , SearchFormat:=False)
                
                If rcell Is Nothing Then GoTo erro
                
                Cells.Find(What:=sProcura, After:=ActiveCell, LookIn:=xlFormulas, LookAt:= _
                xlPart, SearchOrder:=xlByRows, SearchDirection:=xlNext, MatchCase:=False _
                , SearchFormat:=False).Activate
                
                If sAddr = ActiveCell.Address Then
                    GoTo erro
                Else
                    If bAddr = True Then
                        sAddr = ActiveCell.Address
                        bAddr = False
                    End If
                End If
                
                With Me.ListBox1
                    Me.ListBox1.ColumnCount = 3
                    Me.ListBox1.ColumnWidths = "360;60;60"
                    .AddItem ActiveCell.Value
                    .List(ListBox1.ListCount - 1, 1) = ActiveSheet.Name
                    .List(ListBox1.ListCount - 1, 2) = ActiveCell.Address
                End With
                
                If bErro = True Then
    erro:
                    bErro = True
                End If
                
                Loop
                
            Next Sheet
    
    End Sub
    
    Private Sub ListBox1_DblClick(ByVal Cancel As MSForms.ReturnBoolean)
    
    Sheets(Me.ListBox1.List(ListBox1.ListIndex, 1)).Activate
    Range(Me.ListBox1.List(ListBox1.ListIndex, 2)).Activate
    
    
    End Sub

    No listbox ao dar duplo clique no item irá levar para a célula na planilha.

    Com certeza há uma infinidade de códigos mais simples, mas esbocei esse rapidamente e aqui funciona.

    Abraços!


    Rafael Kamimura


    sexta-feira, 26 de junho de 2015 19:42