Um PROCV mais alargado - JJoão (02/2003)

Duvida colocada: "..Tenho valores e texto espalhados em 4 livros, tipo tabelas de dados, que queria localizar, saber se existem e retornar um valor dessa tabela referente ao nome que procuro, já tentei com a função procv mas não consigo aplicar isto a mais de um livro, será possivel ajudar-me ?..

Observação:

Ajuda do Excel sobre Procv: "Localiza um valor na primeira coluna esquerda de uma tabela e devolve o valor na mesma linha de uma coluna que especificou na tabela."

Solução:

Com a função abaixo alarga o numero de tabelas a pesquisar, que podem estar na mesma folha ou em varias folhas ou mesmo noutro livro.

1. Abra o livro onde quiser colocar o(s) resultado(s)
2. Com o livro activo, vá dando nome às tabelas a consultar, mantenha o critério de lhes chamar "Tabela" seguido de um numero, ou o que desejar desde que inicie o nome sempre por "Tabela", para nomear zonas de outros livros só deverá mudar para estes na altura de apontar e seleccionar as zonas, para que os nomes pertençam sempre ao livro do(s) resultado(s), mesmo que apontando para outros livros
3. Insira um modulo (ALT+F11 e no projecto do livro escolha, menu Inserir>modulo)
4. Dentro deste cole a função xProcv

Function xProcv(valor As Variant,coluna As Integer )
   'coluna = coluna do resultado a retornar
    Dim n, resultado
    Dim appWF As WorksheetFunction
    On Error Resume Next
    Application.Volatile
    Set appWF = Application.WorksheetFunction
   'resultado predefinido
    xProcv = "N/A"
   'Testa se existe valor a procurar
    If IsEmpty(valor) = True Then Exit Function
    'Corre todos os Nomes definidos no Livro
    For Each n In ActiveWorkbook.Names
     'recolhe o endereço só dos nomes com Tabelaxxxxx
      If InStr(1, UCase(n.Name), "TABELA", vbTextCompare) > 0 Then
        'resultado da função VLookup
         resultado = appWF.VLookup(valor, Range(n), coluna, False)
        'Testa o resultado
         If IsEmpty(resultado) = False Then
           'retorna o resultado da pesquisa
            xProcv = resultado
            Exit Function
         End If
      End If
    Next
    Set appWF = Nothing
End Function

No exemplo abaixo temos duas tabelas no mesmo livro (com nome definido: tabela1 e tabela2), ao encontrar o numero 10 ou o 11 numa das tabelas, retorna o conteudo da celula ao lado deste valor, ou da coluna que definirmos, desde que dentro da zona da tabela.

Tenha em atenção que para consultar todas as tabelas, os respectivos livros terão que estar abertos, caso contrário se o resultado a retornar estiver num dos livros fechado a função não retornará nada a não ser "N/A".
Atenção se houver repetição do dado a procurar só a 1ª ocorrência será retornada pela função.

Localizar em outros livros, usa o mesmo principio da função anterior só que retorna o nome do(s) livro(s) e da(s) folha(s), em que encontre o valor a procurar

Function xLocalizar(valor As Variant)
    Dim n
    Dim resultado As Integer
    Dim existe_em As String
    Dim appWF As WorksheetFunction
    Application.Volatile
    Set appWF = Application.WorksheetFunction
    On Error Resume Next
   'resultado predefinido
    xLocalizar = "N/A"
   'Testa se existe valor a procurar
    If IsEmpty(valor) = True Then Exit Function
   'Corre todos os Nomes definidos no Livro
    For Each n In ActiveWorkbook.Names
     'recolhe o endereço só dos nomes com Tabelaxxxxx
      If InStr(1, UCase(n.Name), "TABELA", vbTextCompare) > 0 Then
        resultado = appWF.CountIf(Range(n), valor)
        If resultado > 0 Then
          If existe_em = "" Then
             existe_em = Mid(n, 2, InStr(2, n, "!") - 2)
          Else
             existe_em = existe_em & ", " & Mid(n, 2, InStr(2, n, "!") - 2)
          End If
        End If
      End If
    Next
    Set appWF = Nothing
    If existe_em = "" Then existe_em = "Não encontrado"
    xLocalizar = existe_em
End Function

A pesquisa retornou as localizações do valor 31