excel - 如何轻松更改 Excel 中文件的硬编码链接？

Question

我有一个项目，我在一个标有“BigList.xlsx”的 Excel 文件中维护所有学生及其信息的列表。然后，我有大约 40-50 个其他单独的辅助 excel 文件，它们使用VLOOKUP.

例如，在辅助文件的单元格 A1 中，您可能会看到如下所示的公式：

=Vlookup(B3, 
    'c:\documents and settings\user\desktop\[BigList.xlsx]Sheet1'!$a$1:$b$10000,
    2,false).

上面的 vlookup 链接引用了 BigList.xlsx。但是，我刚刚意识到我需要将该文件名更改为其他名称，例如 MasterDatabase.xlsm（注意不同的扩展名）。有没有一种简单的方法可以做到这一点，而不必手动浏览所有 40-50 个文件并进行查找和替换？

我认为基本想法是将硬编码链接更改为动态链接，我可以随时更改 BigList.xlsx 的文件名，而不必返回所有 40-50 个文件来更新它们的链接。

Answer 1

这应该可以满足您的要求 - 也许不是超级快，但如果您只需要在 50 个工作簿上执行一次，它应该就足够了。请注意，替换行应在工作簿的所有工作表中进行替换。

Option Explicit

Public Sub replaceLinks()

    Dim path As String
    Dim file As String
    Dim w As Workbook
    Dim s As Worksheet

    On Error GoTo error_handler

    path = "C:\Users\xxxxxx\Documents\Test\"
    Application.DisplayAlerts = False
    Application.ScreenUpdating = False

    file = Dir$(path & "*.xlsx", vbNormal)
    Do Until LenB(file) = 0
        Set w = Workbooks.Open(path & file)
        ActiveSheet.Cells.Replace What:="'THE_LINK_YOU_WANT_TO_CHANGE'!", _
                Replacement:="'THE_NEW_LINK'!", LookAt:=xlPart
        w.Save
        w.Close
        file = Dir$
    Loop

    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

    Exit Sub

error_handler:
    MsgBox Err.Description
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True

End Sub

Answer 2

您可以在 Excel 2010 中执行此操作，而无需使用任何代码。（如果没记错的话，它也适用于早期版本的 Excel。）

1. 同时在 Excel 中打开所有 50 个辅助 excel 文件。
2. 打开 BigList.xlsx。（您现在在 Excel 中打开了 51 个文件。）
3. 单击File-Save As并将 BigList 保存为 MasterDatabase.xlsm
4. 关闭新的 MasterDatabase.xlsm 文件。
5. Look at one of the ancillary files and verify that Excel has it pointed to the new file.
6. Close and save all files.

Answer 3

This code will automate the link change directly

1. Update your paths to BigList.xlsx and MasterDatabase.xlsm in the code
2. Update your path to the 40-50 files (I have used c:\temp\")
3. The code will then open both these files (for quicker relinking), then one by open the files in strFilePath, change the link from WB1 (strOldMasterFile ) to Wb2 (strOldMasterFile ), then close the saved file

Please note it assumes all these files are closed on code start, as the code will open these file

    Sub ChangeLinks()
        Dim strFilePath As String
        Dim strFileName As String
        Dim strOldMasterFile As String
        Dim strNewMasterFile As String

        Dim WB1 As Workbook
        Dim WB2 As Workbook
        Dim WB3 As Workbook

        Dim lngCalc As Long    

        strOldMasterFile = "c:\testFolder\bigList.xlsx"
        strNewMasterFile = "c:\testFolder\newFile.xlsm"

        On Error Resume Next
        Set WB1 = Workbooks.Open(strOldMasterFile)
        Set WB2 = Workbooks.Open(strNewMasterFile)
        If WB1 Is Nothing Or WB2 Is Nothing Then
            MsgBox "One (or both) of " & vbnerwline & strOldMasterFile & vbNewLine & strNewMasterFile & vbNewLine & "cannot be found"
            WB1.Close False
            WB2.Close False
            Exit Sub
        End If
        On Error GoTo 0

        With Application
            .DisplayAlerts = False
            .ScreenUpdating = False
            .EnableEvents = False
            lngCalc = .Calculation
            .Calculation = xlCalculationManual 
        End With

        strFilePath = "c:\temp\"
        strFileName = Dir(strFilePath & "*.xls*")

        'Error handling as link may not exist in all files
        On Error Resume Next
        Do While Len(strFileName) > 0
            Set WB2 = Workbooks.Open(strFilePath & strFileName, False)
            WB2.ChangeLink strOldMasterFile, strNewMasterFile, xlExcelLinks
            WB2.Save
            WB2.Close False
            strFileName = Dir
        Loop
        On Error GoTo 0

        WB1.Close False
        WB2.Close False

        With Application
            .DisplayAlerts = True
            .ScreenUpdating = True
            .EnableEvents = True
            .Calculation = lngCalc
        End With

        End Sub