☰

Excel VBA 从超链接公式中提取超链接

tag-icon • tag-icon microsoft-excel vba hyperlink
Excel VBA 从超链接公式中提取超链接

我正在尝试编写 VBA 代码来验证电子表格上的链接。我一直运行良好，直到我遇到了从公式创建的超链接。例如=Hyperlink(A1,"Link1")或=Hyperlink(A1&A2,"Link2")

标准Hyperlinks(1).AddressVBA 没有将这些注册为具有链接，并且我在网上找不到任何其他解决方案。

有任何想法吗？

答案1

这是一个简单的方法，可以处理一些你的公式。说A1包含公式：

=HYPERLINK("http://www.google.com","search")

如果我们选择它并运行：

Sub HyperChecker()
    Dim s1 As String, s2 As String, arr

    s1 = ActiveCell.Formula
    s2 = Mid(s1, 12)
    arr = Split(s2, ",")
    MsgBox arr(0)
End Sub

我们得到：

在此处输入图片描述

代码丢弃公式的开始和结束并返回 URL。

如果函数的第一个参数是表达而不是字符串常量。

然后你就需要EVALUATE()那个表情。

答案2

对于更一般的情况，您可以简单地使用类似以下内容：

url_formula = Split(Mid(cell.formula, 12), ",")(0)
Debug.Print Evaluate(url_formula)

其中，Mid(cell.formula, 12)删除了=HYPERLINK(公式的一部分，并Split(..., ",")(0)在逗号部分拆分公式的其余部分（(0)选择拆分的第一部分 - 因此与 Excel 中的大多数索引不同，它以零为基础）。

然后，使用该Evaluate函数计算结果表达式。这应该相当通用，至少在函数Evaluate允许的范围内通用。

答案3

其他答案不能很好地处理公式中的变化。例如，如果公式同时包含 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

相关内容