Excel Макрос: Добавить в текст ячеек столбца C - ссылки из ячеек столбца B

Автор mo0nstr, 27 февраля 2017, 00:13

mo0nstr

Добрый день!

Напишите пожалуйста макрос который - добавит в текст ячеек столбца C - ссылки из ячеек столбца B

Пример файла прикрепляю во вложении.

В оригинальном файле может быть до 50 тыс. заполненных строк.

С уважением

[вложение удалено администратором]

Администратор

Макрос
Sub Метод()

    Dim arr(), lr As Long, i As Long
   
   
    '1. Отключение монитора, чтобы ускорить работу программы.
    Application.ScreenUpdating = False
   
    '2. Поиск последней строки в столбце B.
        ' При использовании метода "End" на листе не должно быть скрытых строк.
    lr = Cells(Rows.Count, "B").End(xlUp).Row
   
    '3. Копирование данных из экселя в массив, чтобы ускорить работу программы:
        ' с массивом быстрее работать, чем с эксель-ячейками.
        ' В данном случае массив будет использоваться только для того, чтобы извлекать данные
        ' из столбца C.
    If lr = 1 Then
        ReDim arr(1 To 1, 1 To 1)
        arr(1, 1) = Range("C1").Value
    Else
        arr() = Range("C1:C" & lr).Value
    End If
   
    '4. Движение по строкам с первой до последней.
    For i = 1 To UBound(arr, 1)
        Cells(i, "C").Hyperlinks.Add Anchor:=Cells(i, "C"), Address:=Cells(i, "B").Hyperlinks(1).Address, _
            TextToDisplay:=arr(i, 1)
    Next i
   
    '5. Включение монитора.
    Application.ScreenUpdating = True
   
End Sub
[свернуть]