Массовое обновление Excel Hyperlink

Question

У меня есть таблица с тысячами строк. Каждая строка содержит гиперссылку с путем.

Путь недействителен, однако его легко исправить, если заменить первую часть на правильное значение.

Example: current hyperlink: F:\Help\index.html

Needed: P:\SystemHelp\index.html

Проблема в том, что стандартный Find / Replace не «видит» содержимое гиперссылок.

Это единственный способ написать макрос или есть другой способ сделать это?

Answer 1

Привет cnx.org, способ заново изобрести функцию Заменить.

Sub FindReplaceHLinks(sFind As String, sReplace As String, _
    Optional lStart As Long = 1, Optional lCount As Long = -1)

    Dim rCell As Range
    Dim hl As Hyperlink

    For Each rCell In ActiveSheet.UsedRange.Cells
        If rCell.Hyperlinks.Count > 0 Then
            For Each hl In rCell.Hyperlinks
                hl.Address = Replace(hl.Address, sFind, sReplace, lStart, lCount, vbTextCompare)
            Next hl
        End If
    Next rCell
End Sub

Sub Doit()

    FindReplaceHLinks "F:\help\", "F:\SystemHelp\"

End Sub

Answer 2

Нет необходимости в макросе

Предупреждение: некоторые вещи, такие как графики и т. Д., Могут быть потеряны, однако формулы и форматы, похоже, сохраняются.

• Сохранить документ в виде таблицы XML

• Открыть файл с помощью Блокнота

• «Заменить все» от «неправильная текстовая строка» на «правильная текстовая строка»

• Сохранить

• Открыть файл в Excel

• Сохранить документ в оригинальном формате

Answer 3

Я не знаю другого пути, кроме макроса. Но похоже, что кто-то уже написал один , чтобы сделать это.

Public Sub ReplaceHyperlinkURL(FindString As String, ReplaceString As String) Dim LinkURL As String Dim PreStr As String Dim PostStr As String Dim NewURL As String Dim FindPos As Integer Dim ReplaceLen As Integer Dim URLLen As Integer Dim MyDoc As Worksheet Dim MyCell As Range On Error GoTo ErrHandler Set MyDoc = ActiveSheet For Each MyCell In MyDoc.UsedRange If MyCell.Hyperlinks.Count > 0 Then LinkURL = MyCell(1).Hyperlinks(1).Address FindPos = InStr(1, LinkURL, FindString) If FindPos > 0 Then 'If FindString is found ReplaceLen = Len(FindString) URLLen = Len(LinkURL) PreStr = Mid(LinkURL, 1, FindPos - 1) PostStr = Mid(LinkURL, FindPos + ReplaceLen, URLLen) NewURL = PreStr & ReplaceString & PostStr MyCell(1).Hyperlinks(1).Address = NewURL 'Change the URL End If End If Next MyCell Exit Sub ErrHandler: MsgBox ("ReplaceHyperlinkURL error") End Sub Public Sub WBReplaceHyperlinkURL(FindString As String, ReplaceString As String) 'For all sheets in the workbook Dim LinkURL As String Dim PreStr As String Dim PostStr As String Dim NewURL As String Dim FindPos As Integer Dim ReplaceLen As Integer Dim URLLen As Integer Dim MyDoc As Worksheet Dim MyCell As Range On Error GoTo ErrHandler For Each WS In Worksheets WS.Activate Set MyDoc = ActiveSheet For Each MyCell In MyDoc.UsedRange If MyCell.Hyperlinks.Count > 0 Then LinkURL = MyCell(1).Hyperlinks(1).Address FindPos = InStr(1, LinkURL, FindString) If FindPos > 0 Then 'If FindString is found ReplaceLen = Len(FindString) URLLen = Len(LinkURL) PreStr = Mid(LinkURL, 1, FindPos - 1) PostStr = Mid(LinkURL, FindPos + ReplaceLen, URLLen) NewURL = PreStr & ReplaceString & PostStr MyCell(1).Hyperlinks(1).Address = NewURL 'Change the URL End If End If Next MyCell Next WS MsgBox ("Hyperlink Replacement Complete") Exit Sub ErrHandler: MsgBox ("ReplaceHyperlinkURL error") End Sub

Код должен быть помещен в модуль кода VBA. Из электронной таблицы откройте редактор VBA на ленте разработчика. Лента разработчика может быть включен в популярной вкладке параметров Excel. Затем выберите Вставить - Модуль из меню. Скопируйте код и вставьте его в модуль. затем сохранить модуль.

Для запуска процедуры создайте макрос, который содержит следующие линии и запустить макрос в Excel. Обязательно замените FindText на часть адреса, которую вы хотите найти, и ReplaceText на текст, которым вы хотите заменить его.

Call ReplaceHyperlinkURL("FindText", "ReplaceText")

Пожалуйста, сделайте резервную копию своей электронной таблицы перед запуск макроса на случай ошибки в FindText или ReplaceText. Если вы хотите выполнить поиск и заменить на все листов в рабочей книге, используйте процедуру WBReplaceHyperlinkURL, а не чем заменить HyperlinkURL.

Answer 4

Вот то, что я обычно использую для этой цели (так как мне никогда не нравились макросы или VB-скриптинг). Это не повлияет на форматирование - все ваши графики и диаграммы останутся без изменений.

1. Переименуйте файл .xlsx или .xls в .zip

2. Распакуйте и отредактируйте соответствующий файл .xml или xml.rels внутри любого текстового редактора на ваш выбор

3. Переименуйте файл .zip обратно в .xlsx (или .xls)

Вот и все.

Для шага 2 вы можете выбрать один из следующих способов:

1. Редактировать прямо в файле .zip ИЛИ

2. Извлеките .zip, затем отредактируйте файл (ы) за пределами .zip, а затем замените его обратно на .zip - перетащите ИЛИ

3. Разархивируйте ZIP-файл, внесите изменения и снова верните его, используя только проводник Windows (щелкните правой кнопкой мыши> Отправить в> Сжатую (сжатую) папку).

Рабочие листы обычно расположены внутри .zip по следующему пути xl > worksheets. Иногда ссылки хранятся в .rels файлах, хранящихся в xl > worksheets > rels

Answer 5

Другим способом является вставка символа «, так что это весь текст, к поиску и замене, а затем пройти и удалить символы».