Excel超链接大量更新 [英] Excel Hyperlink mass update

问题描述

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

I have a spreadsheet with thousands of rows. Each row contains a hyperlink with a path.

该路径无效，但是可以通过将其第一部分替换为正确的值来轻松修复.

The path is not valid, however easily fixable by replacing first part of it with correct value.

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

Needed: P:\SystemHelp\index.html

问题在于标准的查找/替换"无法看到"超链接的内容.

The problem is that standard Find/Replace does not "see" content of hyperlinks.

是编写宏的唯一方法还是还有另一种方法?

Is the only way to write a macro or is there another way to do it?

推荐答案

除了宏之外，我不知道其他方法.但是看起来有人已经写了一个来做到这一点.

I don't know of another way besides a macro. But looks like somebody already wrote one to do it.

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选项"的常用选项卡中打开.然后选择插入- 菜单中的模块.复制代码并将其粘贴到模块中.然后 保存模块.

The code must be placed in a VBA code module. From a spreadsheet, open the VBA Editor in the developer ribbon. The developer ribbon can be turned on in the popular tab of Excel Options. Then select Insert - Module from the menu. Copy the code and paste it into the module. Then save the module.

为了运行该过程，创建一个包含以下内容的宏 行并在Excel中运行宏.确保将FindText替换为 您要查找的地址部分，并用 您要替换为的文本.

In order to run the procedure, create a macro that contains following line and run the macro in Excel. Be sure to replace the FindText with the portion of the address you want to find and ReplaceText with the text you want to replace it with.

Call ReplaceHyperlinkURL("FindText", "ReplaceText")

请务必先制作电子表格的备份副本 运行宏，以防万一在FindText中出错或 ReplaceText.如果要执行搜索并全部替换 工作簿中的工作表，使用WBReplaceHyperlinkURL例程代替 而不是ReplaceHyperlinkURL.

Please be sure to make a backup copy of your spreadsheet before running the macro just in case an error is made in the FindText or ReplaceText. If you want to perform the search and replace on all sheets in the workbook, use the WBReplaceHyperlinkURL routine rather than ReplaceHyperlinkURL.

这篇关于Excel超链接大量更新的文章就介绍到这了，希望我们推荐的答案对大家有所帮助，也希望大家多多支持IT屋！