如何更新多个工作簿的 Excel vlookup 公式？

Question

我有数千个包含 vlookup 公式的 Excel 文件。如何一次性更新所有文件中的公式？文件已移动，我需要它在新路径中查找。

Answer 1

如果只有几个文件需要手动更新，那么可以采用一站式方法。但是，如果您真的有大量文件，那么您可能必须使用 VBA 脚本。

首先是简单的方法：

• 打开您想要更改链接的文件。
• 在功能区中，转到“数据”选项卡，然后单击“编辑链接”按钮。
• 选择移动到新目录的文件并单击“更改源...”按钮
• 保存文件，您就完成了

如果要同时处理多个文件，这可能需要相当长的时间，因此您可以在此处使用宏。我曾经遇到过类似的问题，当时办公室的服务器被替换了。在此分享代码，并不声称它是完美的。

• 打开一个新工作簿并按“alt”+ F11（打开 VBA 编辑器）。
• 那里粘贴以下代码。

根据您的路径调整两个常量：

Option Explicit
Sub replace_links_in_all_files()
    Dim base_file As String, base_path As String, files() As String, index As Long
    Const old_path = "INSERT YOUR OLD PATH HERE"
    Const new_path = "INSERT YOUR NEW PATH HERE"

    'On error show a message and abort
    On Error GoTo error_message

    'Disable screen updating to speed things up, display in status bar
    Application.StatusBar = "Updating links..."
    Application.ScreenUpdating = False

    'Ask for base path
    base_file = Application.GetOpenFilename("All Files (*.*),*.*")

    'End script, if dialogue was cancelled
    If base_file Like False Then Exit Sub

    'Cut string from the selected file
    Do While (InStr(base_file, "\") > 0)
        base_path = base_path & Left(base_file, InStr(base_file, "\"))
        base_file = Right(base_file, Len(base_file) - InStr(base_file, "\"))
    Loop

    'Search the selected path and everything below for Excel files ending in .xlsx
    files = fileSearch(base_path, "*.xlsx")

    'Edit all found files
    For index = LBound(files) To UBound(files)
        Call update_links(files(index), old_path, new_path)
    Next index

    'Reenable screen updating and reset status bar
    Application.ScreenUpdating = True
    Application.StatusBar = False

    'Show info box
    MsgBox prompt:="Skript completed successfully.", Title:="Done"
    Exit Sub

error_message:
    MsgBox "An error occurred. The script cannot be continued.", vbCritical, "Aborting"
    End Sub

'-------------------------------------------------------'
'Replaces the legacy FileSearch-Object since Office 2007'
'-------------------------------------------------------'
Function fileSearch(path As String, name As String) As String()

    Dim filesystem As Scripting.FileSystemObject, sourceDir As Scripting.folder, subDir As Scripting.folder, foundFile As Scripting.file
    Dim found_files() As String, found_sub() As String, length As Long, i As Long
    ReDim found_files(0)

    'Open filesystem
    Set filesystem = New Scripting.FileSystemObject

    'Set folder to search
    Set sourceDir = filesystem.getfolder(path)

    'Check every file in the folder
    On Error GoTo no_access
    For Each foundFile In sourceDir.files
        If foundFile.name Like name Then

        'Append found files to resulting array
        If found_files(0) <> "" Then
            length = length + 1
            ReDim Preserve found_files(length)
        End If
        found_files(length) = foundFile.path
        End If
    Next foundFile

    'Search all subfolders
    For Each subDir In sourceDir.subfolders
        found_sub = fileSearch(subDir.path, name)
        If found_sub(0) <> "" Then

            'Append found files to string, making sure the first entry doesn't stay empty
            If found_files(0) <> "" Then length = length + 1
            ReDim Preserve found_files(length + UBound(found_sub))
            For i = 0 To UBound(found_sub) Step 1
                found_files(length + i) = found_sub(i)
            Next i
            length = length + UBound(found_sub)
        End If
    Next subDir

no_access:
    fileSearch = found_files
    Exit Function

End Function

Private Sub update_links(ByVal filename As String, ByVal old_path, ByVal new_path)

    Dim file As Workbook, sheet As Worksheet

    'Open workbook, display error and abort on error
    Application.DisplayAlerts = False
    On Error GoTo cannot_open
    Set file = Workbooks.Open(filename, 2, False, , "", "", True, , , True, False)

    'Revert to default error handling
    Application.DisplayAlerts = True
    On Error GoTo 0

    'Cycle through every sheet
    For Each sheet In file.Worksheets
        On Error GoTo unknown_ref_error
        sheet.Cells.Replace What:=old_path, Replacement:=new_path, _
            LookAt:=xlPart, SearchOrder:=xlByRows, MatchCase:=False, SearchFormat:=False, ReplaceFormat:=False
        On Error GoTo 0
    Next sheet

    'Save file
    On Error GoTo cannot_save
    Application.DisplayAlerts = False
    file.Close savechanges:=True, filename:=file.path & "\" & file.name
    Application.DisplayAlerts = True
    On Error GoTo 0
    Exit Sub

cannot_open:
    MsgBox ("The file " & filename & " can't be accessed. (is it password protected?)")
    Exit Sub

cannot_save:
    MsgBox ("The file " & filename & " could not be saved.")
    Exit Sub

unknown_ref_error:
    MsgBox ("File " & filename & " : In sheet '" & sheet.name & "' had a reference with unknown error.")
    Resume Next

End Sub

• 启动脚本时，系统会要求您导航到某个文件夹（并选择其中的任意文件，无论哪个文件）。然后，脚本会进入此文件夹及其所有子目录内的每个文件并更新链接。小心！如果有其他不可用的链接或者您的路径有拼写错误，这可能会不可逆转地损坏文件！总是先备份！

Answer 2

如果公式中的路径相同，则可以使用代替特征：