Excel VBA - извлечение URL-адреса из гиперссылки с включением # и после
Следующий код не извлекает URL-адреса после «#»
Установка
URL1/2 в A1/2, затем команда/управление + k, чтобы установить гиперссылку
Пример
A1 = URL1 = http://stackoverflow.com/hello
A2 = URL2 = http://stackoverflow.com/hello#world
Использование кода VBA ниже
=URL(A1) = Результат = http://stackoverflow.com/hello (ЖЕЛАТЕЛЬНО)
=URL(A2) = Результат = http://stackoverflow.com/hello (НЕ ЖЕЛАЕТСЯ)
Желанный:
A2 = http://stackoverflow.com/hello#world
Вопрос
- Есть ли способ изменить код ниже, чтобы включить весь URL-адрес даже после #.
Код VBA
Function URL(Hyperlink As Range)
URL = Hyperlink.Hyperlinks(1).Address
End Function
Ответы 3
Вы можете попробовать это:
URL = Hyperlink.Hyperlinks(1).TextToDisplay
Попробуй это:
Function URL(Hyperlink As Range) As String
Dim sa As String
If Hyperlink.Hyperlinks.Count = 0 Then Exit Function
With Hyperlink.Hyperlinks(1)
sa = .SubAddress 'anything after #
URL = .Address & IIf(sa <> "", "#" & sa, "")
End With
End Function
Это оно! уф, спасибо, сэкономил мне столько работы, что ты даже не представляешь!
Ваша функция принимает диапазон. Если используется диапазон из более чем одной ячейки, каждая из которых содержит гиперссылку. Жесткое кодирование 1 всегда будет возвращать только первую гиперссылку.
Точно так же, как вы проверяете отсутствие гиперссылок, вы также можете проверить наличие нескольких гиперссылок.
Затем решите, что вернуть.
Вот код для возврата всех гиперссылок в диапазоне.
Sub test()
Dim Example1 As String
Dim Example2 As String
Dim Example3 As String
Example1 = URL(ActiveWorkbook.ActiveSheet.Range("A1"))
Example2 = URL(ActiveWorkbook.ActiveSheet.Range("A2"))
Example3 = URL(ActiveWorkbook.ActiveSheet.Range("A1:A3"))
MsgBox "Example 1:" & vbCrLf & Example1 & vbCrLf & "Example 2:" & _
vbCrLf & Example2 & vbCrLf & "Example 3:" & vbCrLf & Example3
End Sub
Function URL(hyperlink As Range) As String
'Returns all hyperlinks in a range as text
If hyperlink.Hyperlinks.Count = 0 Then Exit Function
For a = 1 To hyperlink.Hyperlinks.Count
If hyperlink.Hyperlinks(a).SubAddress <> "" Then
URL = URL & hyperlink.Hyperlinks(a).Address & "#" & hyperlink.Hyperlinks(a).SubAddress & vbCrLf
Else
URL = URL & hyperlink.Hyperlinks(a).Address & vbCrLf
End If
Next a
End Function
Извините, но это показывает только отображаемый текст (A1 или A2), но мне нужен фактический URL-адрес, указанный выше.