您可以使用 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 transactions\Work 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:\Users\User\MyFile.xlsx">>, _
      ThisWorkbook.FullName, xlExcelLinks
End 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:\Users\User\Random\FakeData.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:\Users\User\Random\FakeFolder", LinkToUpdate:="C:\Users\User\Random\FakeData.xlsx"

End Sub

按原样，此代码将遍历“C:\Users\User\Random\FakeFolder”中的每个 Excel (.xlsx) 文件，找到指向“C:\Users\User\Random\FakeData.xlsx”的任何链接"，将它们更改为指向 Excel 文件本身（即删除外部链接），然后保存工作簿。

希望一切顺利！