当前位置：首页 → 问答吧 → 汉字转拼音的完美解决方案可以更完美，Word版飞快注音

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

时间：2009-03-20

来源：互联网

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

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

附件

飞快的拼音标注.rar(22.23 KB)

2009-3-20 22:10, 下载次数: 357

作者: wjhere 发布时间: 2009-03-20

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 编辑 ]

作者: coby001 发布时间: 2009-03-20

谢谢wjhere兄分享！

作者: sylun 发布时间: 2009-03-21

引用:

原帖由 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
您的代码的确很快。

作者: wjhere 发布时间: 2009-03-21

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

作者: wjhere 发布时间: 2009-03-21

看不到代码

作者: 冰风萧萧发布时间: 2009-03-21

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

作者: 冰风萧萧发布时间: 2009-03-21

引用:

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

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

作者: coby001 发布时间: 2009-03-21

'测试文档为朱自清先生的《春》
'根据sylun兄提供KSPPtoASCII3修改
'sylun兄已经发给我最快的测试文档仅3秒多。（因电脑而异）没有得到授权，不宜公开代码
'得到了论坛朋友们的帮助。这个是原来的改进版，改用倒序查找的方法速度达到5秒。
'2009.3.21 [email protected]
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, "飞快标注音标"

附件

飞快的拼音标注.rar(26.52 KB)

2009-3-21 13:16, 下载次数: 90

作者: wjhere 发布时间: 2009-03-21

4 秒不知道算不算快？？

附件

excelx00.PNG(6.94 KB)

2009-3-21 13:23

作者: coby001 发布时间: 2009-03-21

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

作者: coby001 发布时间: 2009-03-21

按照coby001兄的建议，直接调用hz2py类中的IFELanguage_GetMorphResult函数，速度又有进步了。

附件

飞快的拼音标注.rar(22.7 KB)

2009-3-21 13:54, 下载次数: 58

作者: wjhere 发布时间: 2009-03-21

呵呵有快了1秒

附件

excelx00.PNG(6.97 KB)

2009-3-21 14:07

作者: coby001 发布时间: 2009-03-21

楼主能不能解释一下倒序法为什么比顺序法快呢？

作者: coby001 发布时间: 2009-03-21

因为倒序过程中的词语不能增加，而正序循环过程中，添加了拼音域，在循环过程中词语就增加了（其实是刚刚添加的域代码），域代码的长度大呀，哈哈，我也说不清楚了。而倒序循环就不受域代码的影响了。

作者: wjhere 发布时间: 2009-03-21

现在我的问题是如果不使用微软拼音输入法，而使用自己的词库，就像守柔版主的拼音居士的词库，检索速度能否也能这样快。如何实现？

作者: wjhere 发布时间: 2009-03-21

哦这样啊谢谢楼主的解答

作者: coby001 发布时间: 2009-03-21

引用:

原帖由 wjhere 于 2009-3-21 13:16 发表
'测试文档为朱自清先生的《春》
'根据sylun兄提供KSPPtoASCII3修改
'sylun兄已经发给我最快的测试文档仅3秒多。（因电脑而异）没有得到授权，不宜公开代码
'得到了论坛朋友们的帮助。这个是原来的改进版，改用倒序 ...

楼主提到的代码如下。那只是我前段时间学习加注拼音时用到的其中一个测试版本，后发现直接放到楼主的附件中也可运行，所以在与楼主短信交流时提到，虽然速度上较快，但应该还有些问题。
Sub hz2py()
'无选定区域则对全文档的汉字添加拼音
Application.ScreenUpdating = False
On Error Resume Next
Dim oRange As Range, i As Range, info() As String, n As Long
Dim j As Range, c As Long, TF As Boolean
Dim st As Single
st = Timer
Set oRange = VBA.IIf(Selection.Type = wdSelectionIP, ActiveDocument.Content, Selection.Range)
With oRange
For Each i In .Words
      If TF = True Then
         ActiveDocument.Undo
         i.Start = i.Start + 1
         TF = False
      End If
      If i.Text Like "[一-龥]*" Then
         ReDim Preserve info(n)
         info(n) = HzToPy(i.Text) & "|" & i.Start & "|" & i.End
         n = n + 1
      ElseIf Len(i.Text) > 1 And i.Characters.Last Like "[”》]" Then
         i.Characters.Last.Delete
         TF = True
         For Each j In i.Words
            If j.Text Like "[一-龥]*" Then
                  ReDim Preserve info(n)
                  info(n) = HzToPy(j.Text) & "|" & j.Start & "|" & j.End
                  n = n + 1
            End If
         Next
      ElseIf IsDate(i.Text) Then
         For Each j In i.Characters
            If j.Text Like "[一-龥]" Then
                  ReDim Preserve info(n)
                  info(n) = HzToPy(j.Text) & "|" & j.Start & "|" & j.End
                  n = n + 1
            End If
         Next
      End If
Next
End With
For c = UBound(info) To 0 Step -1
ActiveDocument.Range(Split(info(c), "|")(1), Split(info(c), "|")(2)).PhoneticGuide Text:=Split(info(c), "|")(0), FontSize:=10, Raise:=13
If c = 0 Then Exit For
Next
If TF = True Then ActiveDocument.Undo
Debug.Print Timer - st
MsgBox Timer - st
Application.ScreenUpdating = True
End Sub

[ 本帖最后由 sylun 于 2009-3-21 21:00 编辑 ]

作者: sylun 发布时间: 2009-03-21

能不能给点注释啊呵呵

作者: coby001 发布时间: 2009-03-21

sylun 兄终于再次出面了。这下大家可要好好学习，不要以为我的最快了。不过sylun 兄说是没有问题，难道还可以再快，再快就不能快了，已经到达1.8秒了

作者: wjhere 发布时间: 2009-03-21

有得一杰作,谢谢分享!

作者: lcmphy 发布时间: 2009-06-07

好帖，谢谢分享！

作者: yanjie 发布时间: 2009-07-24

能否告诉我，如果只想将汉字转成拼音，不需要汉字，应该如何做？

作者: pangz 发布时间: 2009-11-06

真正的精辟的啊。