我有一个 Excel 单元格,它采用链接文件并将结果乘以存储在不同单元格中的值,即:“链接路径 x R4”。
有没有一种有效的方法来断开链接,这样公式就会显示出来4.53 x R4
?我有数百个这样的公式,所以单独断开每个单元格链接会花费很多时间。谢谢!
例如:'='C:\Users\user\OneDrive\Documents[Camps.xlsx]calendar_23'!$L$6*$r$4'
'C:\Users\user\OneDrive\Documents[Camps.xlsx]calendar_23'!$L$6' 的值为 4.53。
有没有办法让我把这个单元格改为“4.53*$r$4”?我知道我可以突出显示路径并按 F9。但是,我对大量单元格都有这个要求,我希望有一种自动的方法来做到这一点。
答案1
一般来说,这是一个相当困难的问题。在 Excel 中,您可以轻松断开链接并获取每个带有链接的单元格中的当前值。但是,如果要保留公式的结构,并且只将外部引用本身转换为值,则需要彻底分析此事,因为 Excel 的创建者没有预见到这样的操作。
问题在于,链接可以在公式中以不同的形式写入,这取决于源工作簿是否打开,并且链接可以引用单个单元格或范围。
此代码提案进行了一些简化:
- 一个公式仅包含一个外部链接
- 链接指向单个单元格。
包含的代码仅检查活动工作表,但在删除行对后:
If shCur.Name = ActiveSheet.Name Then ' only single sheet
…
End If ' only single sheet
将检查整个工作簿。
如果您使用的是美国版 Excel,则可以使用 属性,Formula
而不是FormulaLocal
。
Sub Remove_Links_From_Cells()
'based upon https://www.ablebits.com/office-addins-blog/find-break-external-links-excel/
Dim rangeCur As Range
Dim rngForms As Range
Dim shCur As Worksheet
Dim psep As Integer
Dim linkFilePath As String, linkFilePath2 As String, linkFileName As String
Dim linksDataArray As Variant
linksDataArray = ActiveWorkbook.LinkSources(xlExcelLinks)
If Not IsEmpty(linksDataArray) Then
linksDataArray = Application.Transpose(linksDataArray)
ReDim Preserve linksDataArray(LBound(linksDataArray) To UBound(linksDataArray), 1 To 3)
' 1 - linkFilePath, 2 - linkFilePath2, 3 - linkFileName
Dim indI As Long
For indI = LBound(linksDataArray) To UBound(linksDataArray)
'follow links' list
linkFilePath = linksDataArray(indI, 1)
'LinkSrouces returns the full file path with the file name
'even if the file is open
psep = Application.Max(InStrRev(linkFilePath, "\"), InStrRev(linkFilePath, "/"))
'linkFileName - extract only the file name
linkFileName = Right(linkFilePath, Len(linkFilePath) - psep)
linksDataArray(indI, 3) = linkFileName
'linkFilePath2 - the file path with the workbook name in square brackets
linkFilePath2 = Left(linkFilePath, psep) & "[" & linkFileName & "]"
linksDataArray(indI, 2) = linkFilePath2
Next indI
Dim linksh As String, linkref As String, linkval, rngForm As String
Application.ScreenUpdating = False
Application.Calculation = xlCalculationManual
For Each shCur In ActiveWorkbook.Worksheets
If shCur.Name = ActiveSheet.Name Then ' only single sheet
On Error Resume Next
Set rngForms = Nothing
Set rngForms = shCur.Cells.SpecialCells(xlCellTypeFormulas)
On Error GoTo 0
If Not rngForms Is Nothing Then
For Each rangeCur In rngForms 'cells with formulas
rngForm = rangeCur.FormulaLocal
For indI = LBound(linksDataArray) To UBound(linksDataArray)
'scan links' list
linkFilePath = linksDataArray(indI, 1)
linkFilePath2 = linksDataArray(indI, 2)
linkFileName = linksDataArray(indI, 3)
' one link per formula
If InStr(rngForm, linkFileName) Then
' external link found
Dim br As Long
br = InStr(rngForm, "]")
If br Then
linksh = Mid(rngForm, br + 1)
linkref = linksh
linksh = Left(linksh, InStr(linksh, "!"))
Else
linksh = "!"
linkref = rngForm
End If
' linksh ends with "'!" or with "!"
linkref = Mid(linkref, InStr(linkref, "!") + 1)
Dim chrset As String, c As Long, res As String, chr As String
chrset = "[0-9A-Za-z$:]"
res = vbNullString
For c = 1 To Len(linkref)
chr = Mid(linkref, c, 1)
If chr Like chrset Then
res = res & chr
Else
Exit For
End If
Next c
Dim res1 As String
res1 = res
If InStr(res, ":") Then
res = Left(res, InStr(res, ":") - 1)
End If 'in case of ":" only the first cell
If InStr(rngForm, linkFilePath2) Then
linkref = "'" & linkFilePath2 & linksh & res
Else
If Len(linksh) > 1 Then
linkref = "[" & linkFileName & "]" & linksh & res
Else
linkref = linkFileName & linksh & res
End If
If InStr(linksh, "'") Then linkref = "'" & linkref
End If
With rangeCur
.FormulaLocal = "=" & linkref
linkval = .Value
If Not IsError(linkval) Then
If Application.IsText(linkval) Then linkval = """" & linkval & """"
If res <> res1 Then linkref = "'" & linkFilePath2 & linksh & res1
.FormulaLocal = Replace(rngForm, linkref, linkval)
End If
End With
Exit For
End If
Next indI
Next rangeCur
End If
End If ' only single sheet
Next shCur
Application.ScreenUpdating = True
Application.Calculation = xlCalculationAutomatic
Else
MsgBox "No external links in the ActiveWorkbook"
End If
End Sub