하이퍼링크 수식에서 하이퍼링크를 추출하는 Excel VBA

하이퍼링크 수식에서 하이퍼링크를 추출하는 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의 대부분의 인덱싱과 달리 0부터 시작합니다).=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

관련 정보