汉字转拼音的完美解决方案可以更完美，Word版飞快注音

wjhere · 发表于 2009-3-20 22:10

简单修改了《汉字转拼音的完美解决方案～[4.5更新]～函数进化》http://club.excelhome.net/viewth ... B4%D2%F4&page=1中的类代码，使之可以正确标注常用的多音字。
使用查找到方法进行，可以过滤无关到字符。
欢迎大家修改代码，看看到底还能有多快！
注意：需要微软拼音输入法2003到支持，微软拼音输入法2007下可能造成程序失去响应！为获得最佳速度，请切换到普通视图。
对汉字转拼音的完美解决方案中的到认知还是极为肤浅的，如果能够再深入了解，让修改后到代码既可以识别多音字，又能够插入空格就更好了。

[ 本帖最后由 wjhere 于 2009-3-21 06:17 编辑 ]

wjhere · 发表于 2009-3-21 06:00

谢谢sylun兄，已读过您的短消息。您总是那么委婉，而有是那么及时。让我从一点烛光，看到早晨的太阳。

coby001 · 发表于 2009-3-20 23:35

Dim S# ' 双精度比较准确
'Dim wL, K As Integer
S = Timer
Application.ScreenUpdating = False  '这句提前了，能节约一点时间
ActiveDocument.ActiveWindow.View.Type = wdNormalView
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False

With ActiveDocument.Content.Find
.ClearFormatting
.Text = "[一-﨩]{1,}"    '这句是什么意思？楼主能解释一下吗？
.MatchWildcards = True
   Do While .Execute
      Set myRr = .Parent

'    Word.Application.StatusBar = myRr.Text '屏蔽了状态栏回显，能节约较多时间

没有做这些小改动前，耗时7秒，之后  耗时 4秒

[ 本帖最后由 coby001 于 2009-3-20 23:40 编辑 ]

sylun · 发表于 2009-3-21 00:45

谢谢wjhere兄分享！

wjhere · 发表于 2009-3-21 05:11

原帖由 coby001 于 2009-3-20 23:35 发表
Dim S# ' 双精度比较准确
'Dim wL, K As Integer
S = Timer
Application.ScreenUpdating = False '这句提前了，能节约一点时间
ActiveDocument.ActiveWindow.View.Type = wdNormalView
ActiveDocument.ActiveW ...

谢谢coby001兄支持，这句表示查找一个以上的连续汉字，要使用通配符。"[一-﨩] " 即代表所有的汉字字符，如同"[0-9]"可以代表0-9的数字相关内容参考http://club.excelhome.net/viewth ... hlight=%B2%E9%D5%D2
您的代码的确很快。

冰风萧萧 · 发表于 2009-3-21 10:27

看不到代码

冰风萧萧 · 发表于 2009-3-21 10:34

没用微软拼音，9秒，都够快了

coby001 · 发表于 2009-3-21 10:57

原帖由 冰风萧萧 于 2009-3-21 10:34 发表
没用微软拼音，9秒，都够快了

呵呵装有office 就默认装有拼音2003 了，只是你没激活它而已，但它还是起作用的

wjhere · 发表于 2009-3-21 13:16

'测试文档为朱自清先生的《春》
'根据sylun兄提供KSPPtoASCII3修改
'sylun兄已经发给我最快的测试文档仅3秒多。（因电脑而异）没有得到授权，不宜公开代码
'得到了论坛朋友们的帮助。这个是原来的改进版，改用倒序查找的方法速度达到5秒。
'2009.3.21 wjhere@126.com
Dim strW As String
Dim strP As String
Dim myR, myRr As Range
Dim S#
Dim wL, K As Integer
S = Timer
On Error Resume Next
Application.ScreenUpdating = False '关闭屏幕刷新
ActiveDocument.ActiveWindow.View.ShowFieldCodes = True '关闭域代码显示

With ActiveDocument.Content.Find
.ClearFormatting
.Text = "[一-﨩]{1,}" '查找一个以上的中文字符
.MatchWildcards = True
.Forward = False '使用通配符，倒序查找
   Do While .Execute

      Set myRr = .Parent '找到的中文字符串区域

   wL = myRr.Words.Count

      For K = wL To 1 Step -1 '使用倒序标注拼音
         Set myR = myRr.Words(K)
         strW = myR.Text
         strP = HzToPy(strW)
         myR.PhoneticGuide Text:=strP, Alignment:=wdPhoneticGuideAlignmentCenter, _
         Raise:=15, FontSize:=14
         myR.Collapse wdCollapseStart
      Next

myRr.Collapse wdCollapseStart ' 折叠到开头，避免二次查找
Loop
End With
Set myR = Nothing
Set myRr = Nothing
ActiveDocument.ActiveWindow.View.ShowFieldCodes = False
Application.ScreenUpdating = True
MsgBox "用时 " & Timer - S & " 秒！", vbInformation, "飞快标注音标"

coby001 · 发表于 2009-3-21 13:23

4 秒不知道算不算快？？

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

[讨论] 汉字转拼音的完美解决方案可以更完美，Word版飞快注音

评分