在 Excel 中将文件路径转换为值

在 Excel 中将文件路径转换为值

我有一个 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 的创建者没有预见到这样的操作。

问题在于,链接可以在公式中以不同的形式写入,这取决于源工作簿是否打开,并且链接可以引用单个单元格或范围。

此代码提案进行了一些简化:

  1. 一个公式仅包含一个外部链接
  2. 链接指向单个单元格。

包含的代码仅检查活动工作表,但在删除行对后:

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

相关内容