ПРЕОБРАЗОВАТЬ массово URL ссылки в кликабельные

admin

Anabolic Gontarski
Команда форума
Администрация
Доверенный
Новичок
Clip2Net Menu_250606122848.jpeg



1. Открыть редактор макросов — сочетанием Alt + F11
2. Выделить ваш проект левой кнопкой мыши (VBAProject (Ваш проект.xIsx), нажать на нем правой и выбрать: Вставить - Модуль (Insert > Module)
3. В пустом окне нового модуля пишем код:

Код:
Sub SetHyperlinks()
    Dim selectedRange As Range
    Dim cell As Range
    Dim linkCell As Range

    ' Проверяем, что выделен диапазон
    If Not TypeName(Selection) = "Range" Then
        MsgBox "Пожалуйста, выделите диапазон."
        Exit Sub
    End If

    Set selectedRange = Selection

    ' Цикл по всем строкам в выделенном диапазоне
    For Each cell In selectedRange.Rows
        ' Определяем ячейку с ссылкой (последний столбец в строке)
        Set linkCell = cell.Cells(cell.Columns.Count)
        ' Проверяем, содержит ли ячейка http ссылку
        If InStr(1, linkCell.Value, "http", vbTextCompare) > 0 Then
            ' Устанавливаем гиперссылку в первой ячейке строки
            cell.Cells(1).Hyperlinks.Add Anchor:=cell.Cells(1), Address:=linkCell.Value
        End If
    Next cell
End Sub

4. Открыть выполнение макросов — сочетанием Alt + F8
5. Жмем "Выполнить" и смотрим результат
 

Макрос который извлекает ссылки из ячеек Ексель​


Код:
Sub ExtractHyperlinks()
    Dim selectedRange As Range
    Dim cell As Range
    Dim hyperlink As Hyperlink

    ' Проверяем, что выделен диапазон
    If Not TypeName(Selection) = "Range" Then
        MsgBox "Пожалуйста, выделите столбец с гиперссылками."
        Exit Sub
    End If

    Set selectedRange = Selection

    ' Цикл по всем ячейкам в выделенном столбце
    For Each cell In selectedRange
        ' Проверяем, содержит ли ячейка гиперссылку
        If cell.Hyperlinks.Count > 0 Then
            Set hyperlink = cell.Hyperlinks(1)
            ' Записываем URL гиперссылки в ячейку справа
            cell.Offset(0, 1).Value = hyperlink.Address
        End If
    Next cell
End Sub

Чтобы использовать этот макрос:

Откройте Excel и перейдите в рабочую книгу, где вы хотите использовать макрос. Нажмите Alt + F11, чтобы открыть редактор VBA. В меню выберите Insert > Module, чтобы создать новый модуль. Скопируйте и вставьте код макроса в окно модуля. Закройте редактор VBA и вернитесь в Excel. Выделите диапазон, в котором вы хотите установить гиперссылки. Запустите макрос, нажав Alt + F8, выбрав SetHyperlinks и нажав Run. Этот макрос автоматически создаст гиперссылки в левом столбце выделенного диапазона, используя ссылки из правого столбца.


Источник: РА "ВЫГОДНО"
 
Назад
Сверху