Word VBA排版通过自动查找替换去除叠字

180it 2019-09-25 PM 2749℃ 0条

叠字主要包括以下几种:
1型aabbcc
2型ababab
3型abcabcabc
4型abcdabcdabcdabcd(这个算思考题,自己根据原理增加吧)
代码原理为通过自建数组和通配符替换逐一替换,无需引入其他数据库,运行速度还可以。
代码如下:

Sub 替换文本()
'替换前文本
Orit = Array("(<[!^13]^13)()\1", "(<[!^13]^13)()\1", "(<[!^13]^13)()\1", _

"([!1-^127]){3}", "([!1-^127]){2}", _
"([!^13]){4}", "([!^13]){3}", "([!^13]){2}", _
"([!^13])([!^13])\1\2{4}", "([!^13])([!^13])\1\2{3}", "([!^13])([!^13])\1\2{2}", _
"([!^13])([!^13])([!^13])\1\3{4}", "([!^13])([!^13])([!^13])\1\3{3}", "([!^13])([!^13])([!^13])\1\3{2}")
    
'替换后文本
Rept = Array("\1\2", "\1\2", "\1\2", _
"\1", "\1", _
"\1", "\1", "\1", _
"\1", "\1", "\1", _
"\1", "\1", "\1")

For i = 0 To UBound(Orit)

  With Selection.Find
     .Text = Orit(i)
     .Replacement.Text = Rept(i)
     .Forward = True
     .Wrap = wdFindContinue
     .Format = False
     .MatchCase = False
     .MatchWholeWord = False
     .MatchByte = False
     .MatchWildcards = True  '运用通配符
     .MatchSoundsLike = False
     .MatchAllWordForms = False
 End With
     Selection.Find.Execute Replace:=wdReplaceAll
Next i

End Sub

注:
{数字}为重复次数,
[!^13]为非段落标记
(<[!13]*13)()\1中:
(<[!13]*13)为查找一段内容;
<[!^13]表示段落的首字
()表示0个或N个内容
, _为换行符,注意有空格
\1表示是第一个表达式的内容
\2表示是第二个表达式的内容
([!^13])用于去除aa叠字
([!13])([!13])\1\2用于去除asas叠字,
([!13])([!13])([!^13])\1\3用于去除asdasd叠字
([!^13])个数即被重叠的字符单元数量,与第二个\数字相对应,重复单元为三个字符,则为\3;重复单元为2个字符,则为\2,以此类推

本文链接:https://blog.csdn.net/weixin_44559388/article/details/86585122

支付宝打赏支付宝打赏 微信打赏微信打赏

如果文章或资源对您有帮助,欢迎打赏作者。一路走来,感谢有您!

标签: none

Word VBA排版通过自动查找替换去除叠字