怎么用VBA替换拼音词汇

pbdq

我的一篇文档内，有大量的类似 干(gān)闼(tà)婆(pó 的词汇，要替换成  乾(qián)闼(tà)婆(pó，连拼音一起替换。

感谢诸位帮忙

附件是测试文档。

拼音词汇替换.zip (9.09 KB, 下载次数: 35)

2014-10-3 18:21 上传

点击文件名下载附件

eh蝴蝶效应

我的思路是这样：
先录制一段最简单的宏，假设将“1替换成2”
将你需要替换的原文中，那两处拼音汉字转换成“域代码A”和“域代码B”
然后编辑原先录制的宏，将1替换成“域代码A”，2替换成“域代码B”
最后运行编辑后的宏

kxzxw

建议楼主学习一下这个帖子：
http://club.excelhome.net/thread-368632-1-1.html

看懂了后，就容易了。

banjinjiu

不成熟的代码，就怕其他字也能替换，请其他高手完善。

1. Sub 拼音词汇域代码替换()
   
2.     Selection.WholeStory
   
3.     Selection.Fields.ToggleShowCodes
   
4.     With Selection.Find
   
5.         .text = "干"
   
6.         .Replacement.text = "乾"
   
7.         .Forward = True
   
8.         .Wrap = wdFindContinue
   
9.         .Format = False
   
10.         .MatchCase = False
    
11.         .MatchWholeWord = False
    
12.         .MatchByte = False
    
13.         .MatchAllWordForms = False
    
14.         .MatchSoundsLike = False
    
15.         .MatchWildcards = True
    
16.     End With
    
17.     Selection.Find.Execute Replace:=wdReplaceAll
    
18.     With Selection.Find
    
19.         .text = "gān"
    
20.         .Replacement.text = "qián"
    
21.         .Forward = True
    
22.         .Wrap = wdFindContinue
    
23.         .Format = False
    
24.         .MatchCase = False
    
25.         .MatchWholeWord = False
    
26.         .MatchByte = False
    
27.         .MatchAllWordForms = False
    
28.         .MatchSoundsLike = False
    
29.         .MatchWildcards = True
    
30.     End With
    
31.     Selection.Find.Execute Replace:=wdReplaceAll
    
32.     Selection.Fields.ToggleShowCodes
    
33. End Sub

复制代码

banjinjiu

请试试这个代码，或许更好点。

1. Sub 拼音词汇域代码替换2()
   
2.     Selection.WholeStory
   
3.     Selection.Fields.ToggleShowCodes
   
4.     Selection.Find.ClearFormatting
   
5.     Selection.Find.Replacement.ClearFormatting
   
6.     With Selection.Find
   
7.         .text = "(gān),干"
   
8.         .Replacement.text = "(qián),乾"
   
9.         .Forward = True
   
10.         .Wrap = wdFindAsk
    
11.         .Format = False
    
12.         .MatchCase = True
    
13.         .MatchWholeWord = False
    
14.         .MatchByte = False
    
15.         .MatchWildcards = False
    
16.         .MatchSoundsLike = False
    
17.         .MatchAllWordForms = False
    
18.     End With
    
19.     Selection.Find.Execute Replace:=wdReplaceAll
    
20.     Selection.Fields.ToggleShowCodes
    
21. End Sub

复制代码

kxzxw

1. Private Sub Test2()
   
2.     Dim SelStart As Long, ManStart As Long, MyRange As Range, SelType As Integer
   
3.     With Selection
   
4.         SelStart = .Start
   
5.         If .Type = wdSelectionIP Then SelType = 1: .Expand wdStory
   
6.         ManStart = .Start
   
7.         .Copy
   
8.         .PasteAndFormat (wdFormatPlainText)
   
9.         .SetRange ManStart, .End
   
10.         Set MyRange = .Range
    
11.         .Find.ClearFormatting
    
12.         .Find.Execute findtext:="干(gān)闼(tà)婆(pó)", replacewith:="乾(qián)闼(tà)婆(pó)", Replace:=2, Wrap:=0, Forward:=True, Format:=False, MatchWildcards:=False
    
13.         Do While .Find.Execute(findtext:="([一-龥])[（\(](*)[）\)]", Format:=False, Forward:=True, MatchWildcards:=True)
    
14.             If .Start < MyRange.Start Then Exit Do
    
15.             .Characters(1).PhoneticGuide Text:=Mid(.Text, 3), Alignment:=0, Raise:=21, FontSize:=7, FontName:="华文细黑"
    
16.             .SetRange .Fields(1).Code.End + 1, .End
    
17.            .Delete
    
18.         Loop
    
19.         .SetRange MyRange.Start, IIf(SelType, SelStart, MyRange.End)
    
20.     End With
    
21. end sub

复制代码

kxzxw

这个代码稍加改造，调用内置对话框可通用。

banjinjiu

kxzxw 发表于 2014-10-5 23:28

丢了一句End Sub，逐字逐句把汉字加注拼音的域是很费时间的。

kxzxw

banjinjiu 发表于 2014-10-6 17:13
丢了一句End Sub，逐字逐句把汉字加注拼音的域是很费时间的。

当然直接替换域代码最快，但使用不友好不方便。
我这样处理，从用户使用角度比较方便，但不快捷。
鱼和熊掌不能兼得……

pbdq

kxzxw 发表于 2014-10-5 23:28

谢谢。你的代码思路很特别。收藏并学习啊。

有空站内信留个地址给我，给您一部佛经啊。