☰

从应用了 =Hyperlink() 公式的单元格中提取 URL

tag-icon • tag-icon microsoft-excel macros hyperlink
从应用了 =Hyperlink() 公式的单元格中提取 URL

我想从应用了此公式的单元格中获取 URL。

=HYPERLINK(CONCATENATE("https://loremipsum.com/#/Advertiser/",[@[Customer CID]],"/.html"), "View")

该公式对我的工作表中的一个列“客户 CID”有结构化引用。

当我尝试将此宏应用到我的工作表时，即使公式正在评估正确的 URL，它也会给出默认值。

Function GetURL(cell As Range, Optional default_value As Variant)
      If (cell.Range("A1").Hyperlinks.Count <> 1) Then
          GetURL = default_value
      Else
          GetURL = cell.Range("A1").Hyperlinks(1).Address
      End If
End Function

但是，当我不应用公式而是通过右键单击单元格向单元格添加超链接时，宏功能=GetUrl([@[Customer CID]], "")就会起作用并提供给我 URL。

是否有人知道如果该单元格正在评估公式中的超链接，我该如何执行此任务以从该单元格中获取超链接？

答案1

没有直接的从带有公式生成的超链接的单元格中获取 URL 的方法。您需要从函数中提取第一个参数HYPERLINK()，然后手动对其进行评估。

这是执行此操作的代码的修改版本：

Function GetURL(cell As Range, Optional default_value As Variant)
  With cell.Range("A1")
    If .Hyperlinks.Count = 1 Then
      GetURL = .Hyperlinks(1).Address
    Else
      If Left$(Replace(Replace(Replace(.Formula, " ", ""), vbCr, ""), vbLf, ""), 11) = "=HYPERLINK(" Then
        Dim idxFirstArgument As Long: idxFirstArgument = InStr(.Formula, "(") + 1
        GetURL = Evaluate(Mid$(.Formula, idxFirstArgument, InStrRev(.Formula, ",") - idxFirstArgument))
      Else
        GetURL = default_value
      End If
    End If
  End With
End Function

请注意，公式中的任何多余的空格或添加的换行符都会得到适当的考虑。


注意事项：

  • 这只适用于具有最外层HYPERLINK()函数的公式。（但是，每个公式都可以重构，使成为最外层，只有一个小缺点；或者，所有公式都可以重构为或HYPERLINK()形式之一，没有任何缺点，只需要对代码进行微小的修改；最后，经过相当多的努力，可以编写代码来解析=IF(…,…,HYPERLINK())=HYPERLINK()任何公式，无论HYPERLINK()函数位于何处。）；
  • 如果在分隔函数的第一个和第二个参数的逗号后面有任何逗号HYPERLINK()，代码将会中断（可以相对容易地修复）。

答案2

其他答案不能很好地处理公式中的变化。例如，如果公式同时包含 LINK_LOCATION 参数和 FRIENDLY_NAME 参数，它们就会失败。如果公式在某些区域有多余的空格或换行符，其他答案也会失败。

这个答案并不完美，但它比我发布此文时找到的其他答案效果更好。我已经确定了此代码可以工作和会失败的情况。

这个 VBA 函数有点长，但它将从 HYPERLINK() 公式或嵌入在单元格中的非公式超链接中提取超链接的 URL/地址。

它首先检查非公式超链接，因为这是最简单、最可靠的提取超链接。如果不存在，它会检查公式中的超链接。

仅当 HYPERLINK() 函数之外除了等号之外没有其他内容时，从公式中提取才有效。

可接受的 HYPERLINK() 公式

它将要按照这个公式进行：

=HYPERLINK("https://" & A1, "My Company Website")

它将要也使用这个公式（注意多余的空格和换行符）：

=    
HYPERLINK(     "https://" & A1, 
         "My Company Website" & B2)

它会不是按照这个公式进行：

=IF(  LEN(A1)=0, "", HYPERLINK("https://" & A1, "My Company Website")  )

功能

Function HyperLinkText(ByVal Target As Excel.Range) As String
    
    ' If TARGET is multiple cells, only check the first cell.
    Dim firstCellInTarget As Excel.Range
    Set firstCellInTarget = Target.Cells.Item(1)
    
    
    Dim returnString As String
    
    
    ' First check if the cell contains a non-formula hyperlink.
    If Target.Hyperlinks.Count > 0 Then
        ' Cell contains a non-formula hyperlink.
        returnString = Target.Hyperlinks.Item(1).Address    ' extract hyperlink text from the Hyperlinks property of the range
    
    Else
        ' Cell does -NOT- contain a non-formula hyperlink.
        '   Check for a formula hyperlink.
        Dim targetFormula As String
        targetFormula = firstCellInTarget.Formula
        
        
        
        Dim firstOpenParenthesisIndex As Long
        firstOpenParenthesisIndex = VBA.InStr(1, _
                                              targetFormula, _
                                              "(", _
                                              VbCompareMethod.vbBinaryCompare)
        
        Dim cleanFormulaHyperlinkPrefix As String
        cleanFormulaHyperlinkPrefix = Left$(targetFormula, firstOpenParenthesisIndex)
        cleanFormulaHyperlinkPrefix = Replace$(Replace$(Replace$(cleanFormulaHyperlinkPrefix, Space$(1), vbNullString), vbCr, vbNewLine), vbLf, vbNullString)
        
        Dim cleanFormulaPart2 As String
        cleanFormulaPart2 = Mid$(targetFormula, firstOpenParenthesisIndex + 1)
        
        Dim cleanFormulaCombined As String
        cleanFormulaCombined = cleanFormulaHyperlinkPrefix & cleanFormulaPart2
        
        
        ' Get all text inside the HYPERLINK() function.
        '   This is either a single LINK_LOCATION parameter or both the
        '   LINK_LOCATION and FRIENDLY_NAME parameters separated by a comma.
        '
        '   Ex. 1 Parameter:        "https://" & $A$1
        '   Ex. 2 Parameters:       "https://" & $A$1, "Click Here To Open the Company URL"
        '
        Const HYPERLINK_FORMULA_PREFIX As String = "=HYPERLINK("
                
        Dim tmpString As String
        tmpString = Mid$(cleanFormulaCombined, VBA.Len(HYPERLINK_FORMULA_PREFIX) + 1)
        
        Dim textInsideHyperlinkFunction As String
        textInsideHyperlinkFunction = Left$(tmpString, VBA.Len(tmpString) - 1)
        
        
        ' Get the first parameter (LINK_LOCATION) from the text inside the HYPERLINK()
        '   function by using =EVALUATE().  If text inside the HYPERLINK() function
        '   contains two parameters, they will be separated by a comma and EVALUATE()
        '   will return an error.  Start with the entire text inside the HYPERLINK()
        '   function.  If EVALUATE() returns an error, remove one character from the end
        '   of the string being evaluated and try again.  Eventually only one parameter
        '   will be evaluated and EVALUATE() will return a text string.
        '
        '   For example, if the string to be evaluated is:
        '
        '       "https://" & $A$1, "Click Here To Open the Company URL"
        '
        '   and cell A1 contains:
        '
        '       mycompany.com
        '
        '   EVALUATE will return:
        '
        '       https://mycompany.com
        '
        Dim hyperlinkLinkLocation As String
        Dim i As Long
        For i = VBA.Len(textInsideHyperlinkFunction) To 1 Step -1   ' with each failure, shrink length of string-to-evaluate by one

            If Not VBA.IsError(Excel.Application.Evaluate("=" & Left$(textInsideHyperlinkFunction, i))) Then
                hyperlinkLinkLocation = Excel.Application.Evaluate("=" & Left$(textInsideHyperlinkFunction, i))
                Exit For        ' ****
            End If

        Next i
        
        returnString = hyperlinkLinkLocation

    End If
    
    
    ' Return the hyperlink string.
    HyperLinkText = returnString
End Function

如何使用该函数

Sub Test()
    ' Display hyperlink of the first cell
    '    in the currently selected range.
    Msgbox HyperLinkText(Selection) ' displays the hyperlink of the first cell
End Sub

相关内容