VBA - Filtro com várias palavras

[Rafael Descio]

Srs,

Eu estou tentando filtrar uma lista que posso fazer com vários palavras, no momento só consigo com apenas uma uma palavras, porque eu possuo uma lista com diversos departamentos, preciso puxar diversos departamentos com várias informações.

Será alguém pode me ajudar ???

Agradeço desde já, segue abaixo o comando como funciona com uma opção única. Peço que detalhe bem... estou bastante enferrujado neste assunto de programação.. anos sem programar...

Private Sub CommandButton7_Click()
    Pesquisa ("Backlog_Geral")
End Sub

Private Sub Pesquisa(ByVal strTipoPesq As String)
    Dim strPesquisa As String
    Dim intContador As Integer
    Dim intContResul As String
    Dim intNumColuna As Integer
    Dim strPlanilha As String
    
    'Verifica o tipo da pesquisa
    If strTipoPesq = "Backlog_Geral" Then
        
        'atribui o nome da planilha que será usada na pesquisa
        strPlanilha = strTipoPesq
        
        'Solicita a entrada de um nome de aplicativo
        strPesquisa = Trim(VBA.Interaction.InputBox("Digite as aréas para Filtrar :", ""))
        'Atribui o número da coluna correspondente
        intNumColuna = 4
     End If
    
    'Caso nada tenha sido digitado ou cancelado, sai da rotina
    If strPesquisa = "" Then
        Exit Sub
    End If
    
    'Inicia o contador de linhas e de pesquisa
    intContador = 2
    intContResul = 6
    
    'Limpa eventuais resultados antigos
    'Worksheets("Pesquisa").Range("A6", "F" & Worksheets("Pesquisa").Rows.Count).Delete
     
    'Varre linha por linha
    Do
        'Verifica se tem linhas a serem lidas ainda
                If Worksheets(strPlanilha).Cells(intContador, 1) <> "" Then
                 'Verifica se o nome digitado foi localizado
            If InStr(UCase(Worksheets(strPlanilha).Cells(intContador, intNumColuna)), UCase(strPesquisa)) <> 0 Then
                'Ativa a sheet de pesquisas
                Worksheets("TESTE").Activate
                'Copia os dados para a sheet de pesquisas
                Worksheets(strPlanilha).Cells(intContador, 1).Copy
                Worksheets("TESTE").Cells(intContResul, 1).Activate
                Worksheets("TESTE").Paste
                Worksheets(strPlanilha).Cells(intContador, 2).Copy
                Worksheets("TESTE").Cells(intContResul, 2).Activate
                Worksheets("TESTE").Paste
                Worksheets(strPlanilha).Cells(intContador, 3).Copy
                Worksheets("TESTE").Cells(intContResul, 3).Activate
                Worksheets("TESTE").Paste
                Worksheets(strPlanilha).Cells(intContador, 4).Copy
                Worksheets("TESTE").Cells(intContResul, 4).Activate
                Worksheets("TESTE").Paste
                Worksheets(strPlanilha).Cells(intContador, 5).Copy
                Worksheets("TESTE").Cells(intContResul, 5).Activate
                Worksheets("TESTE").Paste
                
                'monta a string de busca
                If strPlanilha = "Backlog_Geral" Then
                   Worksheets("TESTE").Cells(intContResul, 5) = "('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 1) & """ AND 'Category' = ""Serviço"" AND 'Type' = ""Serviços de TI"" AND 'Item' =""NA"" AND 'Item' =""NA""  ) OR ('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 3) & """ AND 'Category' = ""Negócio"" AND 'Type' = ""NA"" AND 'Item' =""NA"")"
                Else
                   Worksheets("TESTE").Cells(intContResul, 5) = "('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 1) & """ AND 'Type' = ""Palavra"") OR ('Name' = """ & Worksheets("Backlog_Geral").Cells(intContador, 3) & """ AND 'Category' = ""Negócio"" AND 'Type' = ""NA"")"
               End If
                                'Incrementa o contador de pesquisa
                intContResul = intContResul + 1
            End If
        'Caso não tenha localizado
        Else
            'Sai da rotina
            Exit Do
        End If
        
        
        
        'Incrementa o contador de linhas
        intContador = intContador + 1
    Loop
    
    'Se nenhuma ocorrência foi encontrada, permite ao usuário tentar novamente
    If intContResul < 5 Then
       If MsgBox("Nenhuma palavra semelhante foi localizada. Deseja tentar novamente?", vbYesNo) = vbYes Then
            'Chama novamente a rotina
            Pesquisa strTipoPesq
       End If
    ElseIf intContResul = 5 Then
        'Copia a fórmula para a área de transferência e avisa o usuário
        Worksheets("TESTE").Cells(3, 6).Copy
        MsgBox "A string de pesquisa foi copiada para a área de transferência."
    Else
        'Avisa que mais de um registro foi localizado
        MsgBox "A pesquisa retornou mais de uma ocorrência."
    End If
'Fim
End Sub

Private Sub Worksheet_SelectionChange(ByVal Target As Range)

End Sub

Editado Junho 2, 2010 por kuroi
Adicionar tag CODE

[João.Neto]

Se você quer filtrar uma lista com várias palavras tente usar o próprio recurso de Filtro Avançado do Excel.

http://www.juliobattisti.com.br/excel120av...lo1/licao14.htm