Excel VBA: 提取单元格超链接地址

一、函数办法

Function GetAddress(HyCell)
    Application.Volatile True
    With HyCell.Hyperlinks(1)
        GetAddress = IIf(.Address = "", .SubAddress, .Address)
    End With
End Function

 

 

二、程序办法

Public Sub GetAddress()
Dim i, j
i = Range("B2").End(xlDown).Row
For j = 1 To i
    'Cells(j, 1).Hyperlinks.Add Cells(j, 1), "66", , "test"      ' 激活链接
    'Cells(j, 1).Hyperlinks(1).Address = Cells(i, 2).Hyperlinks(1).Address
    Cells(j, 1).FormulaR1C1 = Cells(j, 2).Hyperlinks(1).Address
Next j

End Sub

三、

Sub getchaolianjie()
On Error Resume Next
For Each cell In Range("A1:A10")
        a = Len(cell.Formula)
       For b = 12 To a
       If Mid(cell.Formula, b, 1) = "," Then
        cell.Offset(0, 1) = Mid(cell.Formula, 13, b - 14)
        Exit For
        End If
        Next b
        Next
End Sub