Office中国论坛/Access中国论坛

标题: 转换为无声调拼音自定义函数（方法二） [打印本页]
作者: tanhong    时间: 2011-6-19 20:59
标题: 转换为无声调拼音自定义函数（方法二）
本帖最后由 tanhong 于 2011-6-21 19:15 编辑

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

  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

复制代码

作者: tmtony    时间: 2011-6-20 12:15
老兄的代码越来越成熟
作者: tanhong    时间: 2011-6-20 12:40
tmtony 发表于 2011-6-20 12:15
老兄的代码越来越成熟

谢谢老大支持，不断学习，不断进步……
作者: tanhong    时间: 2011-6-27 11:39
本帖最后由 tanhong 于 2011-6-28 08:46 编辑

根据叶版的建议，对代码做了改进，减去了一个不必要的循环，如下：
  1. Public Function PinYinNumTones(ByVal strPy As String, _
  2.                                Optional OutputType As NotTonesPinyin = 1) As String

  4.     Dim I           As Integer           '循环变量
  5.     Dim strTones     As String            '声调数字标识
  6.     Dim strPinyin    As String            '无声调拼音

  8.     Const TONESCHR = "āáǎàēéěèīíǐìōóǒòūúǔùǖǘǚǜ"
  9.     Const NOTTONES = "aeiouv"

  11.     '初始变量值
  12.     strTones = 0
  13.     strPinyin = strPy

  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

  25. ChrOutput:

  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
复制代码




欢迎光临 Office中国论坛/Access中国论坛 (http://www.office-cn.net/) Powered by Discuz! X3.3