☰

Excel VBA zum Extrahieren eines Hyperlinks aus der Hyperlink-Formel

tag-icon • tag-icon microsoft-excel vba hyperlink
Excel VBA zum Extrahieren eines Hyperlinks aus der Hyperlink-Formel

Ich versuche, VBA-Code zu schreiben, um Links in Tabellen zu validieren. Ich habe es gut hinbekommen, bis ich auf Hyperlinks gestoßen bin, die aus einer Formel erstellt wurden. Zum Beispiel =Hyperlink(A1,"Link1")oder=Hyperlink(A1&A2,"Link2")

Das Standard Hyperlinks(1).Address-VBA registriert diese nicht als verknüpft und ich kann online keine anderen Lösungen finden.

Irgendwelche Ideen?

Antwort1

Hier ist ein einfacher Ansatz, der damit umgehtmancheIhrer Formeln. Sagen SieA1enthält die Formel:

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

Wenn wir es auswählen und ausführen:

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

wir bekommen:

Bildbeschreibung hier eingeben

Der Code verwirft den Anfang und das Ende der Formel und gibt die URL zurück.

Das Problem entsteht, wenn das erste Argument der Funktion einAusdruckeher als einZeichenfolgenkonstante.

Sie bräuchten dann EVALUATE()diesen Ausdruck.

Antwort2

Im allgemeineren Fall können Sie einfach etwas wie Folgendes verwenden:

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

Dabei Mid(cell.formula, 12)wird dieser =HYPERLINK(Teil der Formel entfernt und Split(..., ",")(0)der Rest der Formel am Kommateil geteilt ( (0)wählt den ersten Teil der Teilung aus – und ist daher im Gegensatz zu den meisten Indizierungen in Excel nullbasiert).

Verwenden Sie dann die EvaluateFunktion, um den resultierenden Ausdruck auszuwerten. Dieser sollte relativ allgemein sein, zumindest so allgemein, wie es die EvaluateFunktion zulässt.

Antwort3

Andere Antworten kommen mit Variationen in der Formel nicht besonders gut zurecht. Sie schlagen beispielsweise fehl, wenn die Formel sowohl den Parameter LINK_LOCATION als auch den Parameter FRIENDLY_NAME enthält. Andere schlagen auch fehl, wenn die Formel in bestimmten Bereichen zusätzliche Leerzeichen oder Zeilenumbrüche enthält.

Diese Antwort ist nicht perfekt, aber sie funktioniert besser als andere Antworten, die ich bis zum Zeitpunkt dieser Veröffentlichung gefunden habe. Ich habe Fälle identifiziert, in denen dieser Code funktioniert und in denen er fehlschlägt.

Diese VBA-Funktion ist etwas lang, aber sie extrahiert die URL/Adresse eines Hyperlinks entweder aus einer HYPERLINK()-Formel oder einem in eine Zelle eingebetteten Nicht-Formel-Hyperlink.

Zuerst wird nach einem Hyperlink gesucht, der nicht in einer Formel enthalten ist, da dies der einfachste und zuverlässigste Weg ist, einen Hyperlink zu extrahieren. Wenn keiner vorhanden ist, wird nach einem Hyperlink in einer Formel gesucht.

Die Extraktion aus einer Formel funktioniert NUR, wenn sich außerhalb der Funktion HYPERLINK() nichts außer einem Gleichheitszeichen befindet.

Akzeptable HYPERLINK()-Formeln

EsWILLEArbeite nach dieser Formel:

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

EsWILLEArbeiten Sie auch an dieser Formel (beachten Sie zusätzliche Leerzeichen und Zeilenumbrüche):

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

Es wirdNICHTArbeite nach dieser Formel:

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

Funktion

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

So verwenden Sie die Funktion

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

verwandte Informationen