查找与替换的基本代码用法之三(批量替换) (VBA)

功能简介：同时进行多个查找与替换，支持非通配符下的特殊字符的替换。
比如，适用于 ISO 文件，因组织机构调整，对所有原有部门一次输入后替换为新部门。
查找的各个内容之间，用英文逗号分隔（","），查找数量不限。
替换的各个内容之间，用英文逗号分隔（","），替换数量必须等同于查找数量，如是删除某
个查找内容，替换中键入""(空空)

 

Private Sub Document_Close() On Error Resume Next Application.CommandBars("Edit").Controls("多个替换").Delete '恢复原有菜单 End Sub '---------------------- Private Sub Document_Open() On Error Resume Next Dim NewButton As CommandBarButton CustomizationContext = ActiveDocument '将自定义组合键和工具命令保存于 活动文档中 '指定 CTRL+F为键盘快捷方式 KeyBindings.Add wdKeyCategoryMacro, "MySub", BuildKeyCode(wdKeyControl, wdKeyF) '指定 F5 为快捷方式 KeyBindings.Add wdKeyCategoryMacro, "MySub", BuildKeyCode(wdKeyF5) Application.CommandBars("Edit").Controls("多个替换").Delete '预防性删除 Set NewButton = Application.CommandBars("Edit").Controls.Add(Type:=msoControlButton, Before:=11) With NewButton .Caption = "多个替换" '命令名称 .FaceId = 100 '命令的 FaceId .Visible = True '可见 .OnAction = "MySub" '指定响应过程名 End With End Sub '---------------------- Sub MySub() UserForm1.Show End Sub '---------------------- Sub ComReset() '恢复默认设置 Application.CommandBars("Edit").Reset End Sub Private Sub CommandButton1_Click() Me.TextBox1 = "" Me.TextBox2 = "" Me.TextBox1.SetFocus End Sub '---------------------- Private Sub CommandButton2_Click() Dim MyFind() As String, MyRep() As String, i As Integer, aStory As Variant On Error Resume Next '检查是否为空 If Me.TextBox1 = "" And Me.TextBox2 = "" Then Exit Sub '定义两个数组,以","分隔 MyFind = Split(Me.TextBox1, ",") MyRep = Split(Me.TextBox2, ",") If UBound(MyRep) <> UBound(MyFind) Then '如果两个文本框的分隔数目不一致,提示 MsgBox "替换的数目与查找数目不一致!", vbExclamation + vbOKOnly, "Warnning" Me.TextBox2.SetFocus Exit Sub End If Application.ScreenUpdating = False With ActiveDocument For i = 0 To UBound(MyFind) '一个从下标为 0 的循环替换 For Each aStory In .StoryRanges '在文档的各个文字部分 '如果是"",则相当于删除原查找内容 aStory.Find.Execute findtext:=MyFind(i), _ replacewith:=VBA.IIf(MyRep(i) = """""", "", MyRep(i)), Replace:=2 '如果有下一节中相同内容文字部分,也进行替换 If Not aStory.NextStoryRange Is Nothing Then _ aStory.NextStoryRange.Find.Execute findtext:=MyFind(i), _ replacewith:=VBA.IIf(MyRep(i) = """""", "", MyRep(i)), Replace:=2 Next Next End With Application.ScreenUpdating = True Unload Me '卸载窗体 End Sub '---------------------- Private Sub UserForm_Initialize() Me.Caption = "多文本替换操作" Me.TextBox1.SetFocus Me.CommandButton2.Default = True End Sub