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
Преобразование HTML-таблицы в профессиональный документ Excel
Преобразование HTML-таблицы в профессиональный документ Excel
Это самый простой способ создания Excel из HTML-таблицы.
Импорт excel в laravel в базу данных
Импорт excel в laravel в базу данных
Здравствуйте, дорогой читатель, в этой статье я расскажу практическим и быстрым способом, как импортировать файл Excel в вашу базу данных с помощью...
0
0
51
3
Перейти к ответу Данный вопрос помечен как решенный

Ответы 3

Вы можете попробовать это:

URL = Hyperlink.Hyperlinks(1).TextToDisplay

Извините, но это показывает только отображаемый текст (A1 или A2), но мне нужен фактический URL-адрес, указанный выше.

Lacer 21.11.2022 18:04
Ответ принят как подходящий

Попробуй это:

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

Это оно! уф, спасибо, сэкономил мне столько работы, что ты даже не представляешь!

Lacer 21.11.2022 18:13

Ваша функция принимает диапазон. Если используется диапазон из более чем одной ячейки, каждая из которых содержит гиперссылку. Жесткое кодирование 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

Другие вопросы по теме