如何按格式批量替换

yoshuya · 发表于 2021-1-21 08:40

原文件如下

想替换成如下效果

原文件.zip (404.12 KB, 下载次数: 6)

413191246se · 发表于 2021-1-21 14:25

* 不瞒各位朋友，楼主的第一道题，费了我 2 个小时的时间才搞定。

Sub aaaa红色加粗下划线_FindSelection_Bold()
Dim r As Range
With Selection
.HomeKey 6
With .Find
.ClearFormatting
.Text = "^13[(（]"
.Replacement.Text = ""
.Forward = True
.MatchWildcards = True
Do While .Execute
With .Parent
Do While .Next Like "[ ]" Or .Next Like "[　]" Or .Next Like ChrW(160) Or .Next Like vbTab Or .Next Like "[A-Z]" Or .Next Like "[)）]"
.MoveEnd
Loop
If .Text Like "?[(（]*[）)]*" Then
.MoveStart
Set r = .Range
With r
.Find.Execute "[ 　^s^t]", , , 1, , , , , , "", 2
.Characters.Last.Text = ")"
.Next.InsertAfter Text:=" "
.InsertAfter Text:=" " & ChrW(160)
.Characters.First.InsertAfter Text:=ChrW(160) & " "
.Characters.First.Text = "("
.MoveEnd 1, -2
.MoveStart 1, 3
With .Font
.ColorIndex = wdRed
.Bold = True
End With
End With
End If
.Start = .End
End With
Loop
End With
End With
'''
'Sub FindBold()'取消加粗
With ActiveDocument.Content.Find
.ClearFormatting
.Font.Underline = wdUnderlineSingle
With .Replacement
.ClearFormatting
.Font.Bold = True
.Font.ColorIndex = wdRed
End With
.Execute Findtext:="", ReplaceWith:="", Format:=True, Replace:=wdReplaceAll
End With
End Sub

复制代码

yoshuya · 发表于 2021-1-21 18:00

413191246se 发表于 2021-1-21 14:25
* 不瞒各位朋友，楼主的第一道题，费了我 2 个小时的时间才搞定。

谢谢，辛苦了

413191246se · 发表于 2021-1-21 18:49

楼主，辛苦是一定的，但是，你应该说说，问题是否解决了呢？我希望听到“问题解决”四个大字。

yoshuya · 发表于 2021-1-22 09:38

413191246se 发表于 2021-1-21 18:49
楼主，辛苦是一定的，但是，你应该说说，问题是否解决了呢？我希望听到“问题解决”四个大字。

问题解决，谢谢了

		自动登录	找回密码
密码			免费注册

[求助] 如何按格式批量替换