转换为无声调拼音自定义函数（方法二）

tanhong

之前发过一个将拼音转换为无声调拼音函数，是通过数组方法实现（请参看之前所发实例），但在实际运行中发现调用要慢很多，将其做了一些改进，用循环比对方法，速度提高不少，发上来分享一下.

1. 
   
2. '枚举无声调拼音输出常量
   
3. Enum NotTonesPinyin
   
4.      NOTONESPINYIN = 1                '无声调拼音
   
5.      NUMTIONES= 2                     '声调数字标识
   
6. End Enum
   
7. '---------------------------------------------------------------------------------------------------
   
8. '功能：实现拼音的转换，如：bāo --> bao ,获得拼的声调：如：bāo 声调为：1
   
9. '输入：strPy字符串变量，为有声调拼音，
   
10. '      OutputType 可选参数，默认参数值： "1"无声调拼音, "2"声调数标识, "3"拼音和声调数字标识
    
11. '输出：String字符串变量
    
12. '调用：1、无 声 调  拼  音：=PinYinNumTones("bǎng")    结果为：bang
    
13. '     2、声     调     值：=PinYinNumTones("bǎng", NumTones)  结果为：3
    
14. '     3、无声调拼音及声调值：=PinYinNumTones("bǎng",NoTonesPinYin + NumTones） 结果为：bang3
    
15. '编程：江羽   2011-6-16
    
16. '----------------------------------------------------------------------------------------------------
    
17. Public Function PinYinNumTones(ByVal strPy As String, _
    
18.                                Optional OutputType As NotTonesPinyin = 1) As String
    
19.     Dim I, J         As Integer             '循环变量
    
20.     Dim strTones     As String              '声调数字标识
    
21.     Dim strPinyin    As String              '无声调拼音
    
22.     Const TONESCHR = "āáǎàēéěèīíǐìōóǒòūúǔùǖǘǚǜ"
    
23.     Const NOTTONES = "aeiouv"
    
24.     '初始变量值
    
25.     strTones = 0
    
26.     strPinyin = strPy
    
27.     '获得声调数字码及无声调拼音
    
28.     For I = 0 To 23: For J = 1 To Len(strPy)
    
29.         If Mid(TONESCHR, I + 1, 1) = Mid(strPy, J, 1) Then
    
30.            '将无音标拼音及声调数值分别赋值给变量
    
31.            strPinyin = Replace(strPy, Mid(strPy, J, 1), Mid(NOTTONES, I \ 4 + 1, 1))
    
32.            strTones = I Mod 4 + 1
    
33.            GoTo ChrOutput  '替换完后跳出，以期提高速度
    
34.         End If
    
35.     Next: Next
    
36. ChrOutput:
    
37.     '按要求输出结果
    
38.     Select Case OutputType
    
39.         Case 1                            '替换不含声调拼音
    
40.             PinYinNumTones = strPinyin
    
41.         Case 2                            '输出声调数字码
    
42.             PinYinNumTones = strTones
    
43.         Case 3                            '以数字标识声调输出拼音
    
44.             PinYinNumTones = strPinyin & strTones
    
45.     End Select
    
46. End Function
    
47. 
    

复制代码

tmtony

老兄的代码越来越成熟

tanhong

tmtony 发表于 2011-6-20 12:15
老兄的代码越来越成熟

谢谢老大支持，不断学习，不断进步……

tanhong

根据叶版的建议，对代码做了改进，减去了一个不必要的循环，如下：

1. Public Function PinYinNumTones(ByVal strPy As String, _
   
2.                                Optional OutputType As NotTonesPinyin = 1) As String
   
3. 
   
4.     Dim I           As Integer           '循环变量
   
5.     Dim strTones     As String            '声调数字标识
   
6.     Dim strPinyin    As String            '无声调拼音
   
7. 
   
8.     Const TONESCHR = "āáǎàēéěèīíǐìōóǒòūúǔùǖǘǚǜ"
   
9.     Const NOTTONES = "aeiouv"
   
10. 
    
11.     '初始变量值
    
12.     strTones = 0
    
13.     strPinyin = strPy
    
14. 
    
15.     '获得声调数字码
    
16.     For I = 0 To 23
    
17.         If InStr(1, strPy, Mid(TONESCHR, I + 1, 1)) > 0 Then
    
18.            '将无音标拼音及声调数值分别赋值给变量
    
19.            strPinyin = Replace(strPy, Mid(TONESCHR, I + 1, 1), Mid(NOTTONES, I \ 4 + 1, 1))
    
20.            strTones = I Mod 4 + 1
    
21.            GoTo ChrOutput  '替换完后跳出，以期提高速度
    
22.         End If
    
23.     Next
    
24. 
    
25. ChrOutput:
    
26. 
    
27.     '按要求输出结果
    
28.     Select Case OutputType
    
29.         Case 1                            '替换不含声调拼音
    
30.             PinYinNumTones = strPinyin
    
31.         Case 2                            '输出声调数字码
    
32.             PinYinNumTones = strTones
    
33.         Case 3                            '以数字标识声调输出拼音
    
34.             PinYinNumTones = strPinyin & strTones
    
35.     End Select
    
36. End Function
    

复制代码