WPS的Excel文档如何利用VB脚本批量替换超链接的内容

原创已于 2025-03-13 21:22:43 修改 · 1.5k 阅读

22 ·

CC 4.0 BY-SA版权

文章标签：

#wps #excel

于 2025-03-13 11:50:40 首次发布

其它专栏收录该内容

27 篇文章

订阅专栏

准备知识

关于WPS的Excel点击单元格打开别的文档的两种方法的探究【为单元格添加超链接】
https://blog.youkuaiyun.com/wenhao_ir/article/details/146212767

激活WPS的Excel文档中的VB编辑器功能

没有激活前的截图如下：
在这里插入图片描述
原因是我们的电脑中缺乏VBA插件，我们点击“开发工具”：

然后在接下来的菜单中点击“切换到VB环境”，此时如果检测到没有安装VBA插件，就会自动安装，如下图所示：

重启WPS后，发现“VB编辑器”的按钮已经没有成灰色不可用的状态了：
在这里插入图片描述
打开“VB编辑器”，界面如下：

简单例子测试VB脚本能够使用

插入模块(插入脚本代码)

按下图进行插入模块操作：
在这里插入图片描述

在上面的代码编辑器中填入代码：

Function swh_sum(a, b)
  swh_sum = a + b
End Function

在这里插入图片描述

`xlsx`文件另存为`xlsm`类型

此时按CTRL+S进行保存操作，出现下面的提示：
在这里插入图片描述
提示告诉我们，类型为xlsx的文档并不支持宏功能，所以我们需要换一种类型。

我们在上图中点击“否”，然后在接下来选择支持宏的文件类型，即xlsm类型：
在这里插入图片描述

可见目录中生成了xlsm文件“replace_link_02.xlsm”

测试脚本能否正常运行

此时再去VB编辑器中把刚才写的代码保存一下。
在这里插入图片描述
然后回到Excel表示，先在A1,B1中分别输入数字3和5：

然后在D1中输入下面的公式：

= swh_sum(A1,B1)

在这里插入图片描述
回车之后就出现了我们想要的结果。

注意:编辑代码前首先要确保相应的Excel工作表无任何操作内容

如果你在编辑代码前选中了某个单元或正对某个单元进行某个操作，那么VB编辑器此时是无法使用，这一点请注意。

批量批换超链接的脚本代码

Sub ReplaceHyperlinkText()
    Dim ws As Worksheet
    Dim hl As Hyperlink
    Dim cell As Range
    Dim oldAddress As String
    Dim newAddress As String
    Dim searchText As String
    Dim replaceText As String
    Dim count As Integer  ' 计数变量
    
    ' 需要替换的内容
    searchText = "Files"   ' 旧字符
    replaceText = "SWH"    ' 新字符
    
    count = 0  ' 初始化计数
    
    ' 遍历当前工作簿的所有工作表
    For Each ws In ThisWorkbook.Sheets
        ' **处理常规超链接**
        For Each hl In ws.Hyperlinks
            oldAddress = hl.Address
            If InStr(1, oldAddress, searchText, vbTextCompare) > 0 Then
                newAddress = Replace(oldAddress, searchText, replaceText)
                hl.Address = newAddress
                count = count + 1
            End If
        Next hl
        
        ' **处理 HYPERLINK 公式的超链接**
        For Each cell In ws.UsedRange
            If cell.HasFormula Then
                If InStr(1, cell.Formula, "HYPERLINK", vbTextCompare) > 0 And _
                   InStr(1, cell.Formula, searchText, vbTextCompare) > 0 Then
                    cell.Formula = Replace(cell.Formula, searchText, replaceText)
                    count = count + 1
                End If
            End If
        Next cell
    Next ws
    
    ' 显示替换的超链接数量
    MsgBox "超链接替换完成！共替换了 " & count & " 个超链接。在查看修改效果前,请先CTRL+S保存文件→关闭文件→再次打开文件，否则已经修改的内容可能因为查看修改效果触发WPS的链接自动修复功能操作被还原。", vbInformation, "完成"
End Sub

利用脚本批量批换超链接中的内容

新建文件replace_link_01.xlsx，然后在里面让两个单元格有超链接内容：
在这里插入图片描述
两个超链接的具体链接内容如下：

现在我们的目录是把两个超链接里面的字符“Files”替换为“SWH”。

先把文件另存为xlsm类型：
在这里插入图片描述
然后打开VB编辑器，找到对应的工作表：

插入模块：

把上面目录中给的“批量批换超链接的脚本代码”复制进去，如下图所示：

然后在VB编辑器中的菜单中点击“运行子过程/用户窗体”
在这里插入图片描述
执行完后在Excel中提示如下：

我们按上面的提示，先不急着查看修改效果，否则已经修改的内容可能因为查看修改效果触发WPS的链接自动修复功能操作被还原。
我们先按CTRL+S保存Excel文件，然后再重新打开查看修改效果，重新打开时如果还需要运行VB脚本，请点击“启用宏”：
在这里插入图片描述
打开之后，我们再去查看修改效果，发现两个单元格的超链接都被替换了：

测试脚本是否能够修改通过HYPERLINK函数加的超链接

参考博文 https://blog.youkuaiyun.com/wenhao_ir/article/details/146223002
我们用下面两条函数语句添加两个超链接：

=HYPERLINK("work\2 Files\SGM4444", "第1个用函数加的路径")

=HYPERLINK("work\2 Files\SGM55555", "第2个用函数加的路径")

在这里插入图片描述
然后再运行脚本：

运行结果如下：

我们查看下相应的单元格的链接(双击单元格查看内容)，看下是否修改了：

可见，两个通过HYPERLINK函数加的超链接的内容也被修改了。

证实脚本修改的是同一个Excel文件中的所有Sheet表

我在replace_link_01.xlsm加入下面的内容：

=HYPERLINK("work\2 Files\SGM4444", "表2第1个用函数加的路径")

=HYPERLINK("work\2 Files\SGM55555", "表2第2个用函数加的路径")

然后再运行在表1右键 Shee1新建的模块中的代码：
发现运行结果如下：
在这里插入图片描述
我表1里面的相关内容之前已经被替换完了，如果只是替换表1里的内容的话，这里运行结果应该是0，但这里不为0，这说明模块里的代码是针对所有的表进行的。
下图显示，表2中的数据也被替换了：

原因其实在工程结构中已经体现出来了，如下图所示：
在这里插入图片描述
从图中我们可以看到，模块1它并没有Sheet1下面，而是与各对象并行的，说明模块针对的是整个xlsm文件。如果要指定只改哪个Sheet的话，应该是要去修改脚本才行。

如何将某个字符串替换为没有(空字符)

比如现在我要将超链接\\10.2.1.17\ft库\work\2 FT-PCB\SGM8253-4Q中的字符串“\10.2.1.17\ft库\”替换掉，那么我只需要像下面这样修改脚本就行了：

    ' 需要替换的内容
    searchText = "\\10.2.1.17\ft库\"   ' 旧字符
    replaceText = ""    ' 新字符

即新字符是一个空字符。

链接中有`%20`这样的内容该怎么办？

当你在Excel表格中查看到链接中有%20这样的内容时，这是Excel在显示链接时把链接字符串中的空格转换为%20来显示了，所以对下面的替换任务：

work\2%20FT-PCB\ 
替换为：
\\10.2.1.17\te-pcb\work\2 FT-PCB\

实际上是下面这个替换任务：

work\2 FT-PCB\ 
替换为：
\\10.2.1.17\te-pcb\work\2 FT-PCB\

即把内容中的%20用空格来替代，相关的脚本语句像下面这样写：

    ' 需要替换的内容
    searchText = "work\2 FT-PCB\ "   ' 旧字符
    replaceText = "\\10.2.1.17\te-pcb\work\2 FT-PCB\"    ' 新字符