如何轻松地将硬编码链接更改为Excel中的文件？
我有一个项目，我在一个标有“BigList.xlsx”的Excel文件中维护我的所有学生及其信息的列表。 然后，我有大约40-50其他单独的辅助excel文件通过使用VLOOKUP链接到BigList。
例如，在辅助文件的单元格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文件，并进行查找和replace？
我认为基本的想法是将硬编码链接改为dynamic链接，我可以随时更改BigList.xlsx的文件名，而不必返回所有40-50文件来更新它们的链接。
这应该做你所需要的 – 也许不是超级快，但如果你只需要在50个工作簿上做一次，那应该足够好。 请注意，replace行应该在工作簿的所有页面中进行replace。
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
您可以在Excel 2010中执行此操作，而不使用任何代码。 （如果内存服务，它也将在早期版本的Excel中工作。）
- 在Excel中同时打开所有50个辅助Excel文件。
- 打开BigList.xlsx。 （您现在在Excel中打开了51个文件。）
- 单击
File–Save As然后将BigList保存为MasterDatabase.xlsm - closures新的MasterDatabase.xlsm文件。
- 查看其中一个辅助文件，并确认Excel是否指向新文件。
- closures并保存所有文件。
此代码将直接自动更改链接
- 在代码中更新到
BigList.xlsx和MasterDatabase.xlsmpath - 更新你的path到40-50文件（我用过c：\ temp \“）
- 然后代码将打开这两个文件（为了更快的重新链接），然后打开
strFilePath的文件，将链接从WB1（strOldMasterFile）更改为Wb2（strOldMasterFile），然后closures保存的文件
请注意，假设所有这些文件都在代码开始时closures，代码将打开这些文件
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