使用VBA清除公式中的SharePoint链接问题咨询

问题描述 #

我编写了一个VBA宏，用于将源工作簿中的指定工作表复制到目标工作簿。但这些工作表内的互相引用公式，复制后仍保留指向源工作簿的SharePoint链接，示例如下：

复制后的公式：
=SUM('https://companyname.com/teams/Accounts/Shared Documents/Reporting/[sourceworkbook.xlsx]Sheet1'!G:G)+SUM('https://companyname.com/teams/Accounts/Shared Documents/Reporting/[sourceworkbook.xlsx]Sheet2'!G:G)

期望实现的本地引用公式：

期望的公式：
=SUM('Sheet1'!G:G)+SUM('Sheet2'!G:G)

当前使用的复制代码：

Sub CopySheetsFromWorkbook()
    Dim sourceWorkbook As Workbook
    Dim destinationWorkbook As Workbook
    Dim sheetNames As Variant
    Dim i As Integer
    Dim lastSheet As Worksheet
    Dim ws As Worksheet
    Dim sourceWorkbookName As String

    ' Set the names of the sheets to copy
    sheetNames = Array("Sheet1", "Sheet2", _
                       "Sheet3")

    ' Set the destination workbook (current workbook)
    Set destinationWorkbook = ThisWorkbook

    ' Prompt user to open the source workbook
    With Application.FileDialog(msoFileDialogOpen)
        .Title = "Select the workbook to copy sheets from"
        .AllowMultiSelect = False
        .Filters.Clear
        .Filters.Add "Excel Files", "*.xls; *.xlsx; *.xlsm; *.xlsb"
        
        If .Show = -1 Then ' If the user selects a file
            Set sourceWorkbook = Workbooks.Open(.SelectedItems(1))
            sourceWorkbookName = sourceWorkbook.Name
        Else
            MsgBox "No file selected. Exiting macro.", vbExclamation
            Exit Sub
        End If
    End With

    ' Find the sheet before which to paste the copied sheets
    On Error Resume Next
    Set lastSheet = destinationWorkbook.Sheets("Sheetname")
    On Error GoTo 0
    
    If lastSheet Is Nothing Then
        MsgBox "Sheet 'Sheetname' not found in the destination workbook.", vbExclamation
        sourceWorkbook.Close False
        Exit Sub
    End If

    ' Loop through the sheet names and copy each one
    Application.ScreenUpdating = False
    For i = LBound(sheetNames) To UBound(sheetNames)
        On Error Resume Next
        Set ws = sourceWorkbook.Sheets(sheetNames(i))
        On Error GoTo 0
        
        If ws Is Nothing Then
            MsgBox "Sheet '" & sheetNames(i) & "' not found in the source workbook.", vbExclamation
            sourceWorkbook.Close False
            Exit Sub
        End If
        
        ' Create a true copy of the sheet in the destination workbook
        ws.Copy Before:=lastSheet
        
        ' Update formulas to remove references to the source workbook
        With destinationWorkbook.Sheets(ws.Name)
            UpdateFormulasToLocal .Cells
        End With
    Next i
    Application.ScreenUpdating = True
    
    ' Close the source workbook without saving
    sourceWorkbook.Close False
    
    MsgBox "Sheets copied successfully.", vbInformation
End Sub

我怀疑是复制方式的问题，能否通过类似Excel右键「移动或复制」的操作实现无链接的公式转换？

解决方案：模拟右键「移动或复制」的效果 #

Excel右键的「移动或复制」操作会自动将跨表引用转换为目标工作簿内的本地引用，不需要手动修改公式。以下是两种可行的实现方式：

方案1：完善公式批量替换逻辑 #

你代码中调用的UpdateFormulasToLocal函数可能未正确实现，补充该函数即可批量替换公式中的外部链接前缀：

' 补充实现公式替换函数
Sub UpdateFormulasToLocal(rng As Range, sourceWBName As String)
    Dim cell As Range
    ' 构造需要替换的外部链接前缀
    Dim oldPrefix As String
    oldPrefix = "'https://companyname.com/teams/Accounts/Shared Documents/Reporting/[" & sourceWBName & "]"
    
    For Each cell In rng
        If cell.HasFormula Then
            ' 替换前缀，保留工作表名和单元格引用
            cell.Formula = Replace(cell.Formula, oldPrefix, "'")
        End If
    Next cell
End Sub

然后修改原代码中调用该函数的部分，传递源工作簿名称参数：

With destinationWorkbook.Sheets(ws.Name)
    UpdateFormulasToLocal .Cells, sourceWorkbookName
End With

方案2：直接用批量替换简化操作 #

无需额外函数，直接在复制工作表后调用Replace方法批量替换外部链接：

' 替换原代码中ws.Copy之后的公式处理部分
ws.Copy Before:=lastSheet
With destinationWorkbook.Sheets(ws.Name)
    .Cells.Replace _
        What:="'https://companyname.com/teams/Accounts/Shared Documents/Reporting/[" & sourceWorkbookName & "]", _
        Replacement:="'", _
        LookAt:=xlPart, _
        MatchCase:=False
End With

额外提示 #

• 如果源工作簿是直接从SharePoint在线打开的，建议先保存到本地再执行复制，避免路径异常导致替换失败。
• 若源工作簿路径不固定，可以通过sourceWorkbook.FullName动态获取完整路径，再提取出需要替换的前缀部分。

内容的提问来源于stack exchange，提问作者vardy95