Excel超链接批量更新

Question

我有一个包含数千行的电子表格.每行包含一个带路径的超链接.

该路径无效,但可以通过使用正确的值替换其第一部分来轻松修复.

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

Needed: P:\SystemHelp\index.html

问题是标准的查找/替换不会"看到"超链接的内容.

是编写宏的唯一方法还是有其他方法可以做到这一点？

Answer 1

嘿cnx.org,重新发明Replace功能的方法.

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 Spread Sheet

• 使用记事本打开文件

• "全部替换"从"错误的文本字符串"到"正确的文本字符串"

• 保存

• 用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例程而不是ReplaceHyperlinkURL.