200分问题：输入汉字如何反查拼音？

Question

'******自定义函数，对任意输入的汉字，可以得到它的拼音的第一个字母********
'//函数入口为汉字串，返回值为该汉字的第一个字母
Public Function getHzPy(hzStr As String) As String
'declare  variable
Dim myHzm As Integer
Dim qm As Integer
Dim wm As Integer
Dim hznm As String
If Len(hzStr) > 1 Then
    myHzm = Asc(Left(hzStr, 1))
Else
    myHzm = Asc(hzStr)
End If
If myHzm >= 0 And myHzm < 256 Then
    '字母
    getHzPy = hzStr
Else
    '汉字
    qm = (myHzm + 65536) \ 256
    wm = (myHzm + 65536) Mod 256
    '十进制到十六进制
    hznm = tento(qm, 16) & tento(wm, 16)
End If
If "B0A1" <= hznm And hznm <= "B0C4" Then
getHzPy = "A"
ElseIf "B0C5" <= hznm And hznm <= "B2C0" Then
getHzPy = "B"
ElseIf "B2C1" <= hznm And hznm <= "B4ED" Then
getHzPy = "C"
ElseIf "B4EE" <= hznm And hznm <= "B6E9" Then
getHzPy = "D"
ElseIf "B6EA" <= hznm And hznm <= "B7A1" Then
getHzPy = "E"
ElseIf "B7A2" <= hznm And hznm <= "B8C0" Then
getHzPy = "F"
ElseIf "B8C1" <= hznm And hznm <= "B9FD" Then
getHzPy = "G"
ElseIf "B9FE" <= hznm And hznm <= "BBF6" Then
getHzPy = "H"
ElseIf "BBF7" <= hznm And hznm <= "BFA5" Then
getHzPy = "J"
ElseIf "BFA6" <= hznm And hznm <= "C0AB" Then
getHzPy = "K"
ElseIf "C0AC" <= hznm And hznm <= "C2E7" Then
getHzPy = "L"
ElseIf "C2E8" <= hznm And hznm <= "C4C2" Then
getHzPy = "M"
ElseIf "C4C3" <= hznm And hznm <= "C5B5" Then
getHzPy = "N"
ElseIf "C5B6" <= hznm And hznm <= "C5BD" Then
getHzPy = "O"
ElseIf "C5BE" <= hznm And hznm <= "C6D9" Then
getHzPy = "P"
ElseIf "C6DA" <= hznm And hznm <= "C8BA" Then
getHzPy = "Q"
ElseIf "C8BB" <= hznm And hznm <= "C8F5" Then
getHzPy = "R"
ElseIf "C8F6" <= hznm And hznm <= "CBF9" Then
getHzPy = "S"
ElseIf "CBFA" <= hznm And hznm <= "CDD9" Then
getHzPy = "T"
ElseIf "CDDA" <= hznm And hznm <= "CEF3" Then
getHzPy = "W"
ElseIf "CEF4" <= hznm And hznm <= "D188" Then
getHzPy = "X"
ElseIf "D1B9" <= hznm And hznm <= "D4D0" Then
getHzPy = "Y"
ElseIf "D4D1" <= hznm And hznm <= "D7F9" Then
getHzPy = "Z"
Else
getHzPy = hznm
End If
End Function
'************************辅助函数，可以从十进制转换到任意进制**********************
'//入口为十进制数，要转换的进制，返回为该进制数
Public Function tento(m As Integer, n As Integer) As String
Dim q As Integer
Dim r As Integer
    tento = ""
    Dim bStr As String
    Do
    Call myDivide(m, n, q, r)
    If r > 9 Then
        bStr = Chr(55 + r)
    Else
        bStr = Str(r)
    End If
    tento = Trim(bStr) & tento
    m = q
    Loop While q <> 0
End Function
'************************辅助过程，得到任意两个数的商和余数***************************
Public Sub myDivide(num1 As Integer, num2 As Integer, q As Integer, r As Integer)
    If num2 = 0 Then
        MsgBox ("非法除数")
        Exit Sub
    End If
    If num1 / num2 >= 0 Then
        q = Int(num1 / num2)
    Else
        q = Int(num1 / num2) + 1
    End If
        r = num1 Mod num2
End Sub

Answer 1

to win911(☆洋☆)　:
你的方法只能查拼音的第一个字母，谁有办法可以查整个拼音的？

Answer 2

能否利用windows自带的输入法？

Answer 3

用输入法生成器将拼音输入法的字库转成TXT文件：
在“逆转换”页中，打开“WINDOWS\SYSTEM”下的“WinPY.wb”，指定一个TXT文件的路径，
点“逆转换”。

Answer 4

我也想知道，沾沾limengchen(lmc)的光，qlming(心思)，你能不能说得在“傻瓜”一点（就像傻瓜相机一样，嘻嘻），我有很多东东没有听说过，比如“逆转换”。谢谢喽！

Answer 5

打开“输入法生成器”就都明白啦。将拼音输入法的字库转成TXT文件， 
对于一个汉字就可以去这个文本文件中去查了。不过，不足的一点是其中有好多的
模糊音，比如“明”字，就有“ming”和“meng”两种拼音。

Answer 6

win911(☆洋☆)　: 你的函数得不出一些汉字的首拼音
例如:深圳的"圳"字

Answer 7

下面的过个函数有问题？（以汉字获得汉字首拼音字母）
例如：深圳的“圳”字，取出的结果就不对。
请函数的主人再研究研究。
-------------------------------------------------'******自定义函数，对任意输入的汉字，可以得到它的拼音的第一个字母********
'//函数入口为汉字串，返回值为该汉字的第一个字母
Public Function getHzPy(hzStr As String) As String
'declare  variable
Dim myHzm As Integer
Dim qm As Integer
Dim wm As Integer
Dim hznm As String
If Len(hzStr) > 1 Then
    myHzm = Asc(Left(hzStr, 1))
Else
    myHzm = Asc(hzStr)
End If
If myHzm >= 0 And myHzm < 256 Then
    '字母
    getHzPy = hzStr
Else
    '汉字
    qm = (myHzm + 65536) \ 256
    wm = (myHzm + 65536) Mod 256
    '十进制到十六进制
    hznm = tento(qm, 16) & tento(wm, 16)
End If
If "B0A1" <= hznm And hznm <= "B0C4" Then
getHzPy = "A"
ElseIf "B0C5" <= hznm And hznm <= "B2C0" Then
getHzPy = "B"
ElseIf "B2C1" <= hznm And hznm <= "B4ED" Then
getHzPy = "C"
ElseIf "B4EE" <= hznm And hznm <= "B6E9" Then
getHzPy = "D"
ElseIf "B6EA" <= hznm And hznm <= "B7A1" Then
getHzPy = "E"
ElseIf "B7A2" <= hznm And hznm <= "B8C0" Then
getHzPy = "F"
ElseIf "B8C1" <= hznm And hznm <= "B9FD" Then
getHzPy = "G"
ElseIf "B9FE" <= hznm And hznm <= "BBF6" Then
getHzPy = "H"
ElseIf "BBF7" <= hznm And hznm <= "BFA5" Then
getHzPy = "J"
ElseIf "BFA6" <= hznm And hznm <= "C0AB" Then
getHzPy = "K"
ElseIf "C0AC" <= hznm And hznm <= "C2E7" Then
getHzPy = "L"
ElseIf "C2E8" <= hznm And hznm <= "C4C2" Then
getHzPy = "M"
ElseIf "C4C3" <= hznm And hznm <= "C5B5" Then
getHzPy = "N"
ElseIf "C5B6" <= hznm And hznm <= "C5BD" Then
getHzPy = "O"
ElseIf "C5BE" <= hznm And hznm <= "C6D9" Then
getHzPy = "P"
ElseIf "C6DA" <= hznm And hznm <= "C8BA" Then
getHzPy = "Q"
ElseIf "C8BB" <= hznm And hznm <= "C8F5" Then
getHzPy = "R"
ElseIf "C8F6" <= hznm And hznm <= "CBF9" Then
getHzPy = "S"
ElseIf "CBFA" <= hznm And hznm <= "CDD9" Then
getHzPy = "T"
ElseIf "CDDA" <= hznm And hznm <= "CEF3" Then
getHzPy = "W"
ElseIf "CEF4" <= hznm And hznm <= "D188" Then
getHzPy = "X"
ElseIf "D1B9" <= hznm And hznm <= "D4D0" Then
getHzPy = "Y"
ElseIf "D4D1" <= hznm And hznm <= "D7F9" Then
getHzPy = "Z"
Else
getHzPy = hznm
End If
End Function
'************************辅助函数，可以从十进制转换到任意进制**********************
'//入口为十进制数，要转换的进制，返回为该进制数
Public Function tento(m As Integer, n As Integer) As String
Dim q As Integer
Dim r As Integer
    tento = ""
    Dim bStr As String
    Do
    Call myDivide(m, n, q, r)
    If r > 9 Then
        bStr = Chr(55 + r)
    Else
        bStr = Str(r)
    End If
    tento = Trim(bStr) & tento
    m = q
    Loop While q <> 0
End Function
'************************辅助过程，得到任意两个数的商和余数***************************
Public Sub myDivide(num1 As Integer, num2 As Integer, q As Integer, r As Integer)
    If num2 = 0 Then
        MsgBox ("非法除数")
        Exit Sub
    End If
    If num1 / num2 >= 0 Then
        q = Int(num1 / num2)
    Else
        q = Int(num1 / num2) + 1
    End If
        r = num1 Mod num2
End Sub