☰

ハイパーリンク数式からハイパーリンクを抽出する 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)

Where は数式の 部分Mid(cell.formula, 12)を削除し、数式の残りをコンマ部分で分割します ( は分割の最初の部分を選択します。したがって、Excel のほとんどのインデックスとは異なり、ゼロベースになります)。=HYPERLINK(Split(..., ",")(0)(0)

次に、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

関連情報