是否可以使用VBA在Excel的整个工作表中删除公式中的工作簿引用

Question

我的第一篇文章，所以请对我宽容一点…

希望在VBA中执行循环，查看包含外部工作簿引用的所有公式，然后将其删除，以便该公式在当前工作簿中显示为相同的工作表名称。

例如：

-工作簿"A"；具有纸张名称"；1〃"2〃；，以及"；3〃；。纸上有公式"；1〃；引用中的单元格"2〃；以及"；3〃；。-然后我复印了一份[工作簿"a"，表"1"]到工作簿"B"；B"；其已经具有片材"；2〃；以及"；3〃；拥有自己的数据(格式相同(。-我想创建一个按钮，这样我就可以删除"A'"链接到将不可避免地出现在工作簿中的每个公式中的原始工作簿"；B"；复制后。

我知道你可以做一个"查找和替换"来获得类似的结果，但按照目前的方式，这需要在不同的工作簿上做几百次，并且正在寻找一种更快的方法(比如把它放在我的个人启用宏的工作簿中，并为任何当前打开的工作簿制作一个按钮来执行(。

目前我有：

Private Sub CommandButton1_Click()
Dim aw As Worksheet
Dim wb As Workbook
Dim b As String
Dim r As Long
Dim c As Long
Dim s As String
Dim k As String
Dim l As String

On Error Resume Next
With ActiveWorkbook.Sheets("Sheet1")
For c = 1 To 20
For r = 1 To 20
b = Cells(r, c).Formula
s = "'J:MPS020000 work order cost detailed transactionsWork order cost files.xlsx'!"
k = ""
k = Replace(b, s, k)
l = k
If b = k Then
Else
Sheets("Sheet1").Range("A1").Offset((r - 1), (c - 1)).Formula = k
End If
On Error Resume Next
Next r
Next c
End With
End Sub

问题是我不断地得到"；运行时错误1004：应用程序定义的或对象定义的错误"；

请帮忙！

Answer 1

考虑到这是多么方便，很难找到。这将把指向一个excel文件的所有引用更改为指向同一工作表/单元格引用，但在当前文件中：

Sub ReLink()
ThisWorkbook.ChangeLink <<THE PATH YOU WANT REMOVED E.G. "C:UsersUserMyFile.xlsx">>, _
ThisWorkbook.FullName, xlExcelLinks
End Sub

如果没有指向要删除的路径的链接，这将引发错误。此外，如果当前工作簿中不存在相同的工作表/单元格引用，则单元格中会出现引用错误。您可能需要在代码中对此进行说明。

让我知道结果如何！

编辑
我重读了你的问题，这次读得很好，据我自己承认，我有点忘乎所以。。。

这是新的Sub。它应该会给你更多的细节，说明为什么上次它不适合你。我怀疑它可能指向了与您预期不同的工作簿，但我们拭目以待。。。！

Sub UpdateExternalLinks(LinkToUpdate As String, Optional NewLink As String, Optional ByVal Workbook As Workbook)

' Update external links in a single workbook

' Args:
' LinkToUpdate - The "old" source. The path to the external Excel file which is being linked to
' NewLink (Optional) - Path to Excel file with which to replace "old" source. _
- If not provided, defaults to reference workbook holding links.
' WorkBook (Optional) - A VBA Workbook Object of the Excel file which contains the external links (the file we want to modify) _
- If not provided, defaults to the "Active" workbook

' If no workbook specified, assume we're looking for links in the Active Workbook
If IsEmpty(Workbook) Then
Workbook = ActiveWorkbook
End If
Debug.Print "Searching for links in " & Workbook.FullName
' If no replacement external link provided, replace external link with workbook link
If NewLink = "" Then
NewLink = Workbook.FullName
End If
Links = Workbook.LinkSources()
' Check any links were found (will error when trying to loop otherwise)
If IsEmpty(Links) Then
Debug.Print ("No external links found.")
Debug.Print
Exit Sub
End If
' Check we have at least one link we wish to update
MatchingLinksFound = False

For Each LinkSource In Links
If LinkSource = LinkToUpdate Then
MatchingLinksFound = True
Exit For
End If
Next LinkSource
If Not MatchingLinksFound Then
Debug.Print ("No external links found matching provided path")
Debug.Print
Exit Sub
End If
' Do the update
Workbook.ChangeLink LinkToUpdate, _
NewLink, xlExcelLinks

Debug.Print "Links updated"
Debug.Print
End Sub

你可以这样运行：

Sub DoUpdate()

UpdateExternalLinks LinkToUpdate:="C:UsersUserRandomFakeData.xlsx"
End Sub

但现在对于"；被带走"；部分我写了另一个Sub，它使用上面的那个，允许你更新一堆单独文件中的链接——在这个例子中，是特定文件夹中的所有Excel(*.xlsx(文件。

警告：如果找到外部链接，此脚本将保存更改。在运行之前备份文件是个好主意。

Sub UpdateExternalLinksInDirectory(DirectoryToSearch As String, LinkToUpdate As String, Optional NewLink As String)
' Create a new instance of excel
Dim objExcel
Set objExcel = CreateObject("Excel.Application")

' Hide the new instance
objExcel.Visible = False
' Block events (message boxes, etc)
objExcel.EnableEvents = False
' Find an loop through Excel files
Dim FSO As Object
Dim Folder As Object
Dim File As Object
Set FSO = CreateObject("Scripting.FileSystemObject")
Set Folder = FSO.GetFolder(DirectoryToSearch)

For Each File In Folder.Files

Set wb = objExcel.Workbooks.Open(File)

UpdateExternalLinks Workbook:=wb, LinkToUpdate:=LinkToUpdate, NewLink:=NewLink

wb.Close

Next File
Set wb = Nothing
Set objExcel = Nothing
Set File = Nothing
Set Folder = Nothing
Set FSO = Nothing

End Sub

你可以这样称呼这个代码：

Sub DoUpdate()

UpdateExternalLinksInDirectory DirectoryToSearch:="C:UsersUserRandomFakeFolder", LinkToUpdate:="C:UsersUserRandomFakeData.xlsx"
End Sub

按原样，此代码将循环通过"Excel"中的每个Excel(.xlsx(文件；C： \Users\User\Random\FakeFolder"；，找到指向"的任何链接；C： \Users\User\Random\FakeData.xlsx"；，将它们更改为指向Excel文件本身(即删除外部链接(，然后保存工作簿。

希望它能成功！