获取汉字首拼音码的二个函数需帮忙改进

fnsmydyang

Public Function PinYin(Tstr As String) As String
'取的单个汉字拼音首码
Dim I As Long
I = Asc(Tstr)
If I >= Asc("啊") And I < Asc("芭") Then PinYin = "A"
If I >= Asc("芭") And I < Asc("擦") Then PinYin = "B"
If I >= Asc("擦") And I < Asc("搭") Then PinYin = "C"
If I >= Asc("搭") And I < Asc("蛾") Then PinYin = "D"
If I >= Asc("蛾") And I < Asc("发") Then PinYin = "E"
If I >= Asc("发") And I < Asc("噶") Then PinYin = "F"
If I >= Asc("噶") And I < Asc("哈") Then PinYin = "G"
If I >= Asc("哈") And I < Asc("击") Then PinYin = "H"
If I >= Asc("击") And I < Asc("喀") Then PinYin = "J"
If I >= Asc("喀") And I < Asc("垃") Then PinYin = "K"
If I >= Asc("垃") And I < Asc("妈") Then PinYin = "L"
If I >= Asc("妈") And I < Asc("拿") Then PinYin = "M"
If I >= Asc("拿") And I < Asc("哦") Then PinYin = "N"
If I >= Asc("哦") And I < Asc("啪") Then PinYin = "O"
If I >= Asc("啪") And I < Asc("欺") Then PinYin = "P"
If I >= Asc("欺") And I < Asc("然") Then PinYin = "Q"
If I >= Asc("然") And I < Asc("撒") Then PinYin = "R"
If I >= Asc("撒") And I < Asc("塌") Then PinYin = "S"
If I >= Asc("塌") And I < Asc("挖") Then PinYin = "T"
If I >= Asc("挖") And I < Asc("昔") Then PinYin = "W"
If I >= Asc("昔") And I < Asc("压") Then PinYin = "X"
If I >= Asc("压") And I < Asc("匝") Then PinYin = "Y"
If I >= Asc("匝") And I <= Asc("座") Then PinYin = "Z"
End Function

Public Function PinYinList(StrHZ As String) As String
'取得汉字字符串的首位拼音码组合字符串
  Dim I As Integer
  Dim StrTemp As String
  For I = 1 To Len(StrHZ)
     StrTemp = StrTemp & PinYin(Mid(StrHZ, I, 1))
     PinYinList = StrTemp
  Next I
End Function
由于汉字编码的特殊性,以上两个函数只限于一级汉字,请大家帮忙有没有更好的函数解决这一问题，谢谢...

fnsmydyang

不要沉下去了,问题还没解决呢,自己顶一下...

tz-chf

northwind的这个函数不好，很多汉字不包括。

fnsmydyang

谢谢TZ_CHF,不知道有没有人提供一个更好的函数帮我解决这一问题呢?