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

coby001

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

wjhere

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

coby001

呵呵 有快了1秒

coby001

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

wjhere

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

wjhere

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

coby001

哦  这样啊   谢谢楼主的解答

sylun

原帖由 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 编辑 ]

coby001

能不能给点注释啊  呵呵

wjhere

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