Jump to content
Fórum Script Brasil
  • 0

PROCV/VLOOKUP puxando dados de planilha mais recente da pasta


Question

Boa tarde, pessoal!

 

Estou tentando consolidar as informações de várias planilhas na minha empresa em uma só, através de PROCV.

 

No entanto, as planilhas bases com as informações de que preciso, são atualizadas conforme necessário e salvas com um novo nome de revisão e pessoa que atualizou (ex.: de ORÇAMENTO REV.10 - Fulano passa para ORÇAMENTO REV.11 - Cicrano). Portanto, toda vez que as planilhas são atualizadas, a fórmula do PROCV deve ser alterada, o que não está sendo muito assertivo. Para isso, voltei a me aventurar no VBA para tentar desenvolver um código para puxar as informações dos arquivos que estiverem salvos com a data mais recente dentro de suas respectivas pastas. Até achei alguns códigos prontos e modifiquei de acordo com as informações das minhas planilhas, mas não consegui fazer funcionar.

Alguém possui um código pronto para isso que preciso?

 

Muito obrigado!

Link to post
Share on other sites

5 answers to this question

Recommended Posts

  • 1

Boa tarde @thifreedom

Não sei se era isso que estava pensando mais esta ai um código que vê qual arquivo na pasta é o mais recente e depois faze a atualização do "vinculo" (comparando os arquivos vinculados com o nome "orçamento"):

Estou colocando também a planilha e pastas que eu fiz os teste:

Código:

Public Sub thifreedom()
Dim txtArquivo As String

ListaArquivos ActiveWorkbook.Path & "\LocalExterno"

txtArquivo = fnIdentificarRecente

sAtualizarLinks "ORÇAMENTO", txtArquivo

'MsgBox txtArquivo

End Sub

Sub ListaArquivos(tLocal As String)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(tLocal)
With Sheets("Pasta")
    r = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each FileItem In SourceFolder.Files
    
        .Cells(r, 1).Formula = FileItem.ParentFolder
        .Cells(r, 2).Formula = FileItem.Name
        .Cells(r, 3).Formula = FileItem.DateCreated
        .Cells(r, 3).NumberFormatLocal = "dd / mm / aaaa"
        .Cells(r, 4).Formula = FileItem.DateLastAccessed
        .Cells(r, 5).Formula = FileItem.DateLastModified
        .Cells(r, 5).NumberFormatLocal = "dd / mm / aaaa"
        r = r + 1
    Next
End With
End Sub

Function fnIdentificarRecente() As String
Dim DtRecente As Double
Dim r As Long
DtRecente = WorksheetFunction.Large(Sheets("Pasta").Range("E:E"), 1)
r = WorksheetFunction.Match(DtRecente, Sheets("Pasta").Range("E:E"), 0)

fnIdentificarRecente = Sheets("Pasta").Cells(r, "A").Value & "\" & _
                        Sheets("Pasta").Cells(r, "B").Value

End Function

Sub sAtualizarLinks(tContem As String, nLink As String)
Dim lLinks As Variant
lLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(lLinks) Then
    For i = 1 To UBound(lLinks)
        p = InStr(lLinks(i), tContem)
        If p > 1 Then
            ActiveWorkbook.ChangeLink lLinks(i), nLink, Type:=xlExcelLinks
        End If
    Next i
End If
End Sub

Arquivo: Planilhas e pastas de teste

Link to post
Share on other sites
  • 0
5 horas atrás, Alyson Ronnan Martins disse:

Boa tarde @thifreedom

Não sei se era isso que estava pensando mais esta ai um código que vê qual arquivo na pasta é o mais recente e depois faze a atualização do "vinculo" (comparando os arquivos vinculados com o nome "orçamento"):

Estou colocando também a planilha e pastas que eu fiz os teste:

Código:

Public Sub thifreedom()
Dim txtArquivo As String

ListaArquivos ActiveWorkbook.Path & "\LocalExterno"

txtArquivo = fnIdentificarRecente

sAtualizarLinks "ORÇAMENTO", txtArquivo

'MsgBox txtArquivo

End Sub

Sub ListaArquivos(tLocal As String)
Dim FSO As Scripting.FileSystemObject
Dim SourceFolder As Scripting.Folder
Dim SubFolder As Scripting.Folder
Dim FileItem As Scripting.File
Dim r As Long

Set FSO = CreateObject("Scripting.FileSystemObject")
Set SourceFolder = FSO.GetFolder(tLocal)
With Sheets("Pasta")
    r = .Cells(Rows.Count, "A").End(xlUp).Row + 1
    
    For Each FileItem In SourceFolder.Files
    
        .Cells(r, 1).Formula = FileItem.ParentFolder
        .Cells(r, 2).Formula = FileItem.Name
        .Cells(r, 3).Formula = FileItem.DateCreated
        .Cells(r, 3).NumberFormatLocal = "dd / mm / aaaa"
        .Cells(r, 4).Formula = FileItem.DateLastAccessed
        .Cells(r, 5).Formula = FileItem.DateLastModified
        .Cells(r, 5).NumberFormatLocal = "dd / mm / aaaa"
        r = r + 1
    Next
End With
End Sub

Function fnIdentificarRecente() As String
Dim DtRecente As Double
Dim r As Long
DtRecente = WorksheetFunction.Large(Sheets("Pasta").Range("E:E"), 1)
r = WorksheetFunction.Match(DtRecente, Sheets("Pasta").Range("E:E"), 0)

fnIdentificarRecente = Sheets("Pasta").Cells(r, "A").Value & "\" & _
                        Sheets("Pasta").Cells(r, "B").Value

End Function

Sub sAtualizarLinks(tContem As String, nLink As String)
Dim lLinks As Variant
lLinks = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(lLinks) Then
    For i = 1 To UBound(lLinks)
        p = InStr(lLinks(i), tContem)
        If p > 1 Then
            ActiveWorkbook.ChangeLink lLinks(i), nLink, Type:=xlExcelLinks
        End If
    Next i
End If
End Sub

Arquivo: Planilhas e pastas de teste

 

Show cara!! Obrigado pela disposição em ajudar!

Como você associaria isso a um comando de procv/vlookup?

 

 

Link to post
Share on other sites
  • 0
40 minutos atrás, Alyson Ronnan Martins disse:

Teria que ter uma ideia de com o está usando o seu código porêm seria um procv  "normal" pesquisando valor de outra tabela. É o link seria atualizado sozinho com o Código.

 

AHHH agora peguei a lógica. Funcionou certinho! Salvou demais, muito muito muito obrigado!!!

 

Link to post
Share on other sites

Join the conversation

You can post now and register later. If you have an account, sign in now to post with your account.

Guest
Answer this question...

×   Pasted as rich text.   Paste as plain text instead

  Only 75 emoji are allowed.

×   Your link has been automatically embedded.   Display as a link instead

×   Your previous content has been restored.   Clear editor

×   You cannot paste images directly. Upload or insert images from URL.



  • Forum Statistics

    • Total Topics
      149288
    • Total Posts
      645685
×
×
  • Create New...