关于取的 汉字拼音 首字母函数 的问题。

xlonger

TRYNEW的函数，代码精炼，到目前为止发现的情况是，HZPY判断“金属”为JZ，多音字原因，但认识“埭”字（D）。

Function HZPY(hzstr As String) As String
Dim p0 As String, C As String, STR As String
Dim i As Integer, j As Integer
p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"
For i = 1 To Len(hzstr)
    C = "z"
    STR = Mid(hzstr, i, 1)
    If Asc(STR) > 0 Then
        C = STR
    Else
        For j = 1 To 26
            If Mid(p0, j, 1) > STR Then
                C = Chr(95 + j)
                Exit For
            End If
        Next
    End If
    HZPY = HZPY + C
Next
End Function

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

ntcat的函数不认识，“埭”字，判断为Z,实际是D，http://zhidao.baidu.com/question/5376451.html

但能判断“金属”为JS

－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－－

看到一段其他语言的代码，http://www.cnblogs.com/billyxing/archive/2006/07/24/87199.html#458463

..........汉字拼音首字母列表 本列表包含了20901个汉字,用于配合 GetChineseSpell 函数使用,本表收录的字符的Unicode编码范围为19968至40869，...............好像比较全，通过查早汉字，我发现，对埭字，属字都分类正确。

不知道有谁能转换成VBA的函数？其他的方法好像也都有问题，有的不是纯函数，速度也不行。

－－－－－－－－－－－－－－－－－－－－－－－－－

关于取得汉字的第一个拼音字母的函数,推荐使用我的GetPyAbOfHz函数.速度比上述HZPY快一倍. 不信? 测试代码附后



Public Function GetFirstChr(ByVal sSrc As String)
    Dim sTemp As String
    sTemp = Left(sSrc, 1)
Select Case Asc(sTemp)
    Case 48 To 122
         GetFirstChr = sTemp
    Case Is >= Asc("匝")
         GetFirstChr = "Z"
    Case Is >= Asc("压")
         GetFirstChr = "Y"
    Case Is >= Asc("昔")
         GetFirstChr = "X"
    Case Is >= Asc("挖")
         GetFirstChr = "W"
    Case Is >= Asc("塌")
         GetFirstChr = "T"
    Case Is >= Asc("撒")
         GetFirstChr = "S"
    Case Is >= Asc("然")
         GetFirstChr = "R"
    Case Is >= Asc("期")
         GetFirstChr = "Q"
    Case Is >= Asc("啪")
         GetFirstChr = ""
    Case Is >= Asc("哦")
         GetFirstChr = "O"
    Case Is >= Asc("拿")
         GetFirstChr = "N"
    Case Is >= Asc("妈")
         GetFirstChr = "M"
    Case Is >= Asc("垃")
         GetFirstChr = "L"
    Case Is >= Asc("喀")
         GetFirstChr = "K"
    Case Is >= Asc("击")
         GetFirstChr = "J"
    Case Is >= Asc("哈")
         GetFirstChr = "H"
    Case Is >= Asc("噶")
         GetFirstChr = "G"
    Case Is >= Asc("发")
         GetFirstChr = "F"
    Case Is >= Asc("蛾")
         GetFirstChr = "E"
    Case Is >= Asc("搭")
         GetFirstChr = "D"
    Case Is >= Asc("擦")
         GetFirstChr = "C"
    Case Is >= Asc("芭")
         GetFirstChr = "B"
    Case Is >= Asc("啊")
         GetFirstChr = "A"
    Case Else
         GetFirstChr = "0"
End Select
End Function
'取得汉字的拼音缩写
Public Function GetPyAbOfHz(ByVal sHz As String) As String
    Dim sTmp, ch As String
    Dim i As Integer
    For i = 1 To Len(sHz)
        ch = Mid(sHz, i, 1)
        Select Case ch
            Case ".", "(", ")", "+", "-"
                sTmp = sTmp & ch
            Case " "
            Case Else
                sTmp = sTmp & GetFirstChr(ch)
        End Select
    Next
    GetPyAbOfHz = sTmp
End Function

[此贴子已经被作者于2006-8-4 15:47:01编辑过]

fan0217

从Win系统中分离出来的“汉字拼音首字母列表”，可以通过定义函数来查询，但速度都不理想。

其中不但包括了字，还有很多词组。

fan0217

链接示例中的表就是从Win系统分离出来的：http://www.office-cn.net/forum.php?mod=viewthread&tid=44701