none
Procv em diferentes pastas via VBA RRS feed

  • Pergunta

  • Olá,

    Tenho uma pasta de trabalho que está cheia de fórmulas com procv e isso atrapalha bastante, pois quando perde a referência de uma célula, já era... efeito dominó

    Estou tentando fazer o procv em vba, mas não obtive muito sucesso. A minha pasta tem várias colunas, sendo que uma dela é como se o fosse o id [número do pedido], através dessa coluna que possui vários números de pedidos, eu preciso preencher todas as colunas planilha com os dados relacionados a esse pedido. (Nome, data, companhia...)

    A pessoa que usa essa pasta, apenas cola dados na coluna [Pedido] e a fórmula importa os dados de todas as outras células.

    Os dados estão em uma outra pasta e as colunas não estão na mesma ordem que a minha pasta está.

    Existe algum meio de fazer isso?

    [pasta com fórmulas]

    [pasta com banco]

    Desde já, obrigada!


    • Editado Lidiq quarta-feira, 21 de agosto de 2013 19:11 acrescentar informações
    quarta-feira, 21 de agosto de 2013 19:06

Respostas

  • Private Enum ePedido
        Cliente = 1
        CentroDeCusto
        Atividade
        Pedido
        Hospede
        DtEmissão
        Localidade
        Fornecedor
        QtDiária
        TarifaAplicada
        Taxa
        Total
        CentroDeCusto2
        CentroDeCusto3
        Atividade2
        Atividade3
        FilialIntercia
        FilialIntercia2
        EmpresaIntercia
        ChaveContábil
    End Enum
    
    Private Enum eBD
        Pedido = 2
        DataPedido
        Solicitante
        Passageiro
        Fornecedor
        Localidade
        CheckIn
        CheckOut
        Diárias
        TarifaAplicada
        Taxas
        Total
        CentroDeCusto
        FilialIntercia
        Atividade
        Mês
    End Enum
    
    Sub fncMain()
        'Este código deverá ficar num módulo da pasta de trabalho de pedidos.
        
        Dim lngPedido As Long
        Dim lngLastPedido As Long
        Dim lngBD As Long
        Dim wksPedido As Worksheet
        Dim wksBD As Worksheet
        
        'Mude o caminho abaixo ou use Set wksPedido = ActiveSheet
        Set wksPedido = ThisWorkbook.Worksheets("FT 608615 86.119,23 15AGO13")
        'Para a linha abaixo funcionar, coloque a pasta de trabalho de banco de dados
        'no mesmo diretório da pasta de trabalho de pedidos.
        Set wksBD = Workbooks.Open(ThisWorkbook.Path & "\BANCO DE DADOS.XLSM").Worksheets("Hospedagens BancoDados")
        
        With wksPedido
            lngLastPedido = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
        
        For lngPedido = 10 To lngLastPedido
            lngBD = fncMatch(wksPedido.Cells(lngPedido, ePedido.Pedido), wksBD.Columns(eBD.Pedido))
            If lngBD > 0 Then
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto) = wksBD.Cells(lngBD, eBD.CentroDeCusto)
                wksPedido.Cells(lngPedido, ePedido.Atividade) = wksBD.Cells(lngBD, eBD.Atividade)
                wksPedido.Cells(lngPedido, ePedido.Localidade) = wksBD.Cells(lngBD, eBD.Localidade)
                wksPedido.Cells(lngPedido, ePedido.Fornecedor) = wksBD.Cells(lngBD, eBD.TarifaAplicada)
                wksPedido.Cells(lngPedido, ePedido.Taxa) = wksBD.Cells(lngBD, eBD.Taxas)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto2) = wksBD.Cells(lngBD, eBD.CentroDeCusto)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto3) = wksBD.Cells(lngBD, eBD.CentroDeCusto)
                wksPedido.Cells(lngPedido, ePedido.Atividade2) = wksBD.Cells(lngBD, eBD.Atividade)
                wksPedido.Cells(lngPedido, ePedido.Atividade3) = wksBD.Cells(lngBD, eBD.Atividade)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia) = wksBD.Cells(lngBD, eBD.FilialIntercia)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia2) = wksBD.Cells(lngBD, eBD.FilialIntercia)
            Else
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Atividade) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Localidade) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Fornecedor) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Taxa) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto2) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto3) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Atividade2) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Atividade3) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia2) = CVErr(xlErrNA)
            End If
        Next lngPedido
        
        wksBD.Parent.Close False
    End Sub
    
    Function fncMatch(ByVal str As String, ByVal varVetor As Variant) As Long
        Dim Temp As Long
        
        On Error Resume Next
        Temp = WorksheetFunction.Match(str + 0, varVetor, 0)
        If Temp = 0 Then Temp = WorksheetFunction.Match(CStr(str), varVetor, 0)
        On Error GoTo 0
        
        fncMatch = Temp
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 2 de setembro de 2013 21:43
    Moderador

Todas as Respostas

  • Olá,

    'Tentei' fazer algo pra testar e ver quais erros apresentariam. O código é esse

    Sub teste()
    
    Dim pBanco As Worksheet 'aba do banco'
    Dim pAtual As Worksheet 'aba atual da pasta'
    
    Set pAtual = Workbooks("Faturas Hospedagens Rateio").ActiveSheet
    
    Workbooks.Open Filename:= _
            "D:\Users\u166372\Documents\viagens\BANCO DE DADOS - Viagens, Hospedagem e Locação.xlsm"
    Set pBanco = Workbooks("BANCO DE DADOS - Viagens, Hospedagem e Locação").Sheets("Hospedagens BancoDados")
    
    With pAtual
    Lf = .Cells(.Rows.Count, 1).End(xlUp).Row
    End With
    
    
    For i = 10 To Lf
    Cells(i, "A").Value = WorksheetFunction.VLookup(Cells(i, "D"), pBanco.Range("$B$6:$Q$2335"), pBanco.Range("D:D"), 0)
    Next i
    
    End Sub
    

    mas não deu em nada. Diz que "não é possível obter a propriedade VLookup da clase WorksheetFunction"

    quinta-feira, 22 de agosto de 2013 20:50
  • ????
    terça-feira, 27 de agosto de 2013 14:14
  • Lidiq,

    No meu entendimento, seu cenário é o seguinte: você possui uma pasta de trabalho que possui uma base de dados, que está fechada. Seu objetivo é obter os campos associados à esses códigos na pasta de trabalho ativa, certo?

    Isso pode ser feito com PROCV, como está querendo, mas tenho uma sugestão melhor para o seu caso. No entanto, para que eu sugira um código, você poderia disponibilizar uma amostra tanto da pasta de trabalho que serve como base de dados como da pasta de trabalho que deverá ser preenchida consultando a base de dados?


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 28 de agosto de 2013 01:50
    Moderador
  • Benzadeus,

    Sim, vou disponibilizar :)


    Pasta de trabalho

    Banco

    Obrigada pela ajuda!

    • Editado Lidiq quarta-feira, 28 de agosto de 2013 11:46
    quarta-feira, 28 de agosto de 2013 11:45
  • Lidiq,

    Estou confuso, as pastas de trabalho são muito grandes e não sei onde buscar e o que buscar.

    Você deve observar alguns pontos importantes no que se trata da disponibilização de arquivos. Antes de disponibilizar um arquivo, certifique-se de que:

    -Não há dados que comprometam você, alguma empresa ou outra(s) pessoa(s) no arquivo. Gere dados fictícios e altere valores financeiros para não ter dores de cabeça.

    -Se possível, anexe apenas um arquivo que explique o problema que está tendo, e não a pasta de trabalho completa. É desanimador tentar ajudar pessoas que enviam uma pasta de trabalho de 5MB com mais de dez planilhas para resolver um problema que não precisaria de toda informação presente.

    -Quando for o caso, crie uma planilha (ou arquivos) de Antes e outra de Depois. Ajuda a quem for resolver o problema saber o que deverá ser resolvido.

    ---

    Bom, de qualquer forma, acho que se você me explicar onde está a base de dados e qual campo deverá ser correlacionado, ajudará.


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quinta-feira, 29 de agosto de 2013 00:53
    Moderador
  • Benzadeus,

    Disponibilizei o arquivo errado. De qualquer forma, obrigada pela dica.

    A aba do banco que preciso é a aba [Hospedagem Banco de Dados], a aba tem vários dados de pedidos vários meses.

    No caso, o usuário dessa pasta cola os dados de pedidos na coluna [Pedido], em seguida entra em ação o procv que procura os respectivos dados do banco para preencher as colunas. (Solicitante, Cliente, Valores, etc.)

    Deixei nas pastas apenas as duas abas que serão necessárias

    quinta-feira, 29 de agosto de 2013 12:24
  • Private Enum ePedido
        Cliente = 1
        CentroDeCusto
        Atividade
        Pedido
        Hospede
        DtEmissão
        Localidade
        Fornecedor
        QtDiária
        TarifaAplicada
        Taxa
        Total
        CentroDeCusto2
        CentroDeCusto3
        Atividade2
        Atividade3
        FilialIntercia
        FilialIntercia2
        EmpresaIntercia
        ChaveContábil
    End Enum
    
    Private Enum eBD
        Pedido = 2
        DataPedido
        Solicitante
        Passageiro
        Fornecedor
        Localidade
        CheckIn
        CheckOut
        Diárias
        TarifaAplicada
        Taxas
        Total
        CentroDeCusto
        FilialIntercia
        Atividade
        Mês
    End Enum
    
    Sub fncMain()
        'Este código deverá ficar num módulo da pasta de trabalho de pedidos.
        
        Dim lngPedido As Long
        Dim lngLastPedido As Long
        Dim lngBD As Long
        Dim wksPedido As Worksheet
        Dim wksBD As Worksheet
        
        'Mude o caminho abaixo ou use Set wksPedido = ActiveSheet
        Set wksPedido = ThisWorkbook.Worksheets("FT 608615 86.119,23 15AGO13")
        'Para a linha abaixo funcionar, coloque a pasta de trabalho de banco de dados
        'no mesmo diretório da pasta de trabalho de pedidos.
        Set wksBD = Workbooks.Open(ThisWorkbook.Path & "\BANCO DE DADOS.XLSM").Worksheets("Hospedagens BancoDados")
        
        With wksPedido
            lngLastPedido = .Cells(.Rows.Count, "A").End(xlUp).Row
        End With
        
        For lngPedido = 10 To lngLastPedido
            lngBD = fncMatch(wksPedido.Cells(lngPedido, ePedido.Pedido), wksBD.Columns(eBD.Pedido))
            If lngBD > 0 Then
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto) = wksBD.Cells(lngBD, eBD.CentroDeCusto)
                wksPedido.Cells(lngPedido, ePedido.Atividade) = wksBD.Cells(lngBD, eBD.Atividade)
                wksPedido.Cells(lngPedido, ePedido.Localidade) = wksBD.Cells(lngBD, eBD.Localidade)
                wksPedido.Cells(lngPedido, ePedido.Fornecedor) = wksBD.Cells(lngBD, eBD.TarifaAplicada)
                wksPedido.Cells(lngPedido, ePedido.Taxa) = wksBD.Cells(lngBD, eBD.Taxas)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto2) = wksBD.Cells(lngBD, eBD.CentroDeCusto)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto3) = wksBD.Cells(lngBD, eBD.CentroDeCusto)
                wksPedido.Cells(lngPedido, ePedido.Atividade2) = wksBD.Cells(lngBD, eBD.Atividade)
                wksPedido.Cells(lngPedido, ePedido.Atividade3) = wksBD.Cells(lngBD, eBD.Atividade)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia) = wksBD.Cells(lngBD, eBD.FilialIntercia)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia2) = wksBD.Cells(lngBD, eBD.FilialIntercia)
            Else
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Atividade) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Localidade) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Fornecedor) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Taxa) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto2) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.CentroDeCusto3) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Atividade2) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.Atividade3) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia) = CVErr(xlErrNA)
                wksPedido.Cells(lngPedido, ePedido.FilialIntercia2) = CVErr(xlErrNA)
            End If
        Next lngPedido
        
        wksBD.Parent.Close False
    End Sub
    
    Function fncMatch(ByVal str As String, ByVal varVetor As Variant) As Long
        Dim Temp As Long
        
        On Error Resume Next
        Temp = WorksheetFunction.Match(str + 0, varVetor, 0)
        If Temp = 0 Then Temp = WorksheetFunction.Match(CStr(str), varVetor, 0)
        On Error GoTo 0
        
        fncMatch = Temp
    End Function


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    segunda-feira, 2 de setembro de 2013 21:43
    Moderador
  • Olá, Benzadeus,

    Eu testei o código e fiz as alterações necessárias, ele executou, mas não mudou nada na pasta.

    terça-feira, 3 de setembro de 2013 14:59
  • Experimente trocar

     lngLastPedido = .Cells(.Rows.Count, "A").End(xlUp).Row

    por

    lngLastPedido = .Cells(.Rows.Count, ePedido.Pedido).End(xlUp).Row


    Felipe Costa Gualberto - http://www.ambienteoffice.com.br

    quarta-feira, 4 de setembro de 2013 01:18
    Moderador