Excel超链接批量更新

除了宏,我不知道其他的方法。但看起来像是某人 already wrote one 做这件事。

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替换为 要查找的地址部分,并用替换文本 要用其替换的文本。

Call ReplaceHyperlinkURL("FindText", "ReplaceText")

请务必在之前备份您的电子表格 在findtext出错或 替换文本如果要对所有项执行搜索和替换 工作表在工作簿中,请使用wbpreplaceHyperlinkURL例程 而不是replaceHyperlinkURL。

嘿,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

不需要宏

警告:一些东西,如图表等,可能会丢失,但公式和格式似乎保留。

• 将文档另存为XML电子表格

• 用记事本打开文件

• 将“所有”从“错误的文本字符串”替换为“正确的文本字符串”

• 保存

• 用Excel打开文件

• 以原始格式保存文档

另一种方法是插入一个“字符,使其全部为文本”,搜索并替换,然后遍历并删除“字符”。

这是我通常用于此目的的工具(因为我对宏或VB脚本不太熟悉)。这不会影响任何格式-所有图形和图表都将保持原样。

1. 重命名 .xlsx 或 .xls 文件到 .zip

2. 解压并编辑适当的 .xml 或 xml.rels 使用您选择的任何文本编辑器将文件放入

3. 重命名 邮编 归档到 XLSX (或) XLS )

就是这样。

对于步骤2,您可以选择以下方法之一:

1. 直接在 邮编 文件或

2. 提取 邮编 ,然后在 邮编 然后把它放回 邮编 -拖放或

3. 解压缩.zip,进行编辑,然后仅使用Windows资源管理器(右键单击>发送到>压缩(zipped)文件夹)再次将其压缩。

工作表通常位于 邮编 在以下路径中 xl > worksheets . 有时链接存储在 .rels 文件存储在 xl > worksheets > rels