MyTetra Share
Делитесь знаниями!
Замена гиперссылок с формулой =ГИПЕРССЫЛКА() на обычные
Время создания: 16.03.2019 23:43
Текстовые метки: Hyperlinks,Работа с диапазонами ячеек и листами
Раздел: !Закладки - VBA - Excel - Листы

Замена гиперссылок с формулой =ГИПЕРССЫЛКА() на обычные

Иногда требуется заменить на листе все гиперссылки, созданные при помощи функции листа =ГИПЕРССЫЛКА(), на обычные гиперссылки.

В этом поможет VBA-функция FormulaHyperlink, и основанный на ней макрос:

Function FormulaHyperlink(ByRef cell As Range) As String
    If cell.HasFormula And (cell..Count = 0) Then
        If cell.Formula Like "=HYPERLINK*" Then
            FormulaHyperlink = Evaluate(Mid$(Split(cell.Formula, ",")(0), 12))
        End If
    End If
End Function

Выделите диапазон ячеек, и запустите этот макрос (не забыв добавить ниже его функцию FormulaHyperlink)

Sub ЗаменаГиперссылокСформуламиНаОбычныеВВыделенномДиапазоне()
    Dim cell As Range: Application.ScreenUpdating = False
    For Each cell In Selection ' перебираем все выделенные ячейки
        addr$ = FormulaHyperlink(cell) ' берем ссылку из формулы
        If Len(addr$) Then ' если ссылка есть, то
            cell.Value = cell.Value ' заменяем формулу значением
            cell.Hyperlinks.Add cell, addr$ ' заново прописываем гиперссылку
        End If
    Next cell
End Sub

А этот макрос заменит все гиперссылки в 3-м столбце активного листа:
(пример - в прикреплённом файле)

Sub ЗаменаГиперссылокСформуламиНаОбычные()
    Dim cell As Range, ra As Range: Application.ScreenUpdating = False
    Set ra = Range([c1], Range("c" & Rows.Count).End(xlUp))
    For Each cell In ra.Cells
        addr$ = FormulaHyperlink(cell)
        If Len(addr$) Then
            cell.Value = cell.Value
            cell.Hyperlinks.Add cell, addr$
        End If
    Next cell
End Sub


Вложение

Размер

Загрузки

Последняя загрузка

Hyperlinks.xls

29.5 КБ

90

2 дня 16 часов назад

  • 11783 просмотра
Так же в этом разделе:
 
MyTetra Share v.0.53
Яндекс индекс цитирования