当输入一个汉字时，如何返回它的拼音的第一个字母。。

Question

好急

Answer 1

以前别人贴的……Public Function GetPY(a1 As String) As String                                   '返回拼音码字符串
    
    '输入参数:a1 输入字符串
    
    Dim Jsqte As Long
    Dim t1 As String
    GetPY = ""
    If Len(Trim(a1)) = 0 Then
        Exit Function
    End If
    For Jsqte = 1 To Len(Trim(a1))
        t1 = Mid(a1, Jsqte, 1)
        If Asc(t1) < 0 Then
            If Asc(t1) < Asc("啊") Then
                GetPY = GetPY + t1
                GoTo L1
            End If
            If Asc(t1) >= Asc("啊") And Asc(t1) < Asc("芭") Then
                GetPY = GetPY + "A"
                GoTo L1
            End If
            If Asc(t1) >= Asc("芭") And Asc(t1) < Asc("擦") Then
                GetPY = GetPY + "B"
                GoTo L1
            End If
            If Asc(t1) >= Asc("擦") And Asc(t1) < Asc("搭") Then
                GetPY = GetPY + "C"
                GoTo L1
            End If
            If Asc(t1) >= Asc("搭") And Asc(t1) < Asc("蛾") Then
                GetPY = GetPY + "D"
                GoTo L1
            End If
            If Asc(t1) >= Asc("蛾") And Asc(t1) < Asc("发") Then
                GetPY = GetPY + "E"
                GoTo L1
            End If
            If Asc(t1) >= Asc("发") And Asc(t1) < Asc("噶") Then
                GetPY = GetPY + "F"
                GoTo L1
            End If
            If Asc(t1) >= Asc("噶") And Asc(t1) < Asc("哈") Then
                GetPY = GetPY + "G"
                GoTo L1
            End If
            If Asc(t1) >= Asc("哈") And Asc(t1) < Asc("击") Then
                GetPY = GetPY + "H"
                GoTo L1
            End If
            If Asc(t1) >= Asc("击") And Asc(t1) < Asc("喀") Then
                GetPY = GetPY + "J"
                GoTo L1
            End If
            If Asc(t1) >= Asc("喀") And Asc(t1) < Asc("垃") Then
                GetPY = GetPY + "K"
                GoTo L1
            End If
            If Asc(t1) >= Asc("垃") And Asc(t1) < Asc("妈") Then
                GetPY = GetPY + "L"
                GoTo L1
            End If
            If Asc(t1) >= Asc("妈") And Asc(t1) < Asc("拿") Then
                GetPY = GetPY + "M"
                GoTo L1
            End If
            If Asc(t1) >= Asc("拿") And Asc(t1) < Asc("哦") Then
                GetPY = GetPY + "N"
                GoTo L1
            End If
            If Asc(t1) >= Asc("哦") And Asc(t1) < Asc("啪") Then
                GetPY = GetPY + "O"
                GoTo L1
            End If
            If Asc(t1) >= Asc("啪") And Asc(t1) < Asc("期") Then
                GetPY = GetPY + "P"
                GoTo L1
            End If
            If Asc(t1) >= Asc("期") And Asc(t1) < Asc("然") Then
                GetPY = GetPY + "Q"
                GoTo L1
            End If
            If Asc(t1) >= Asc("然") And Asc(t1) < Asc("撒") Then
                GetPY = GetPY + "R"
                GoTo L1
            End If
            If Asc(t1) >= Asc("撒") And Asc(t1) < Asc("塌") Then
                GetPY = GetPY + "S"
                GoTo L1
            End If
            If Asc(t1) >= Asc("塌") And Asc(t1) < Asc("挖") Then
                GetPY = GetPY + "T"
                GoTo L1
            End If
            If Asc(t1) >= Asc("挖") And Asc(t1) < Asc("昔") Then
                GetPY = GetPY + "W"
                GoTo L1
            End If
            If Asc(t1) >= Asc("昔") And Asc(t1) < Asc("压") Then
                GetPY = GetPY + "X"
                GoTo L1
            End If
            If Asc(t1) >= Asc("压") And Asc(t1) < Asc("匝") Then
                GetPY = GetPY + "Y"
                GoTo L1
            End If
            If Asc(t1) >= Asc("匝") Then
                GetPY = GetPY + "Z"
                GoTo L1
            End If
        Else
            If UCase(t1) <= "Z" And UCase(t1) >= "A" Then
                GetPY = GetPY + UCase(t1)
            Else
                GetPY = t1
            End If
        End If
L1:
    Next Jsqte
    
End Function

Answer 2

Function pinyin(ByVal x As String) As String
Const hanzi = "啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ"
If x = "座" Then pinyin = "Z"
For i = 1 To 23
If Asc(x) >= Asc(Mid(hanzi, i, 1)) And Asc(x) < Asc(Mid(hanzi, i + 1, 1)) Then pinyin = Mid(hanzi, 24 + i, 1)
Next
End Function

Answer 3

看看这个http://community.csdn.net/Expert/topic/3258/3258116.xml?temp=.6120417

Answer 4

这问题...需要考虑一下多音字。长 -> 你是要得到 C （chang)，还是Z (zhang) ？ 这是个问题。

Answer 5

Public Function ChinesePronounce(ByVal Chinese As String, Optional Lower As Boolean = False) As String
'将汉字转换拼音首字母
On Error GoTo er
 Dim hz As String
 Dim MyHzm As Integer
 Dim Qm As Integer
 Dim Wm As Integer
 Dim HzNm As String
 Dim I As Integer
 Dim TmpStr As String
 hz = Chinese
For I = 1 To Len(hz)
    TmpStr = Mid(hz, I, 1)
    MyHzm = Asc(TmpStr)
    If MyHzm >= 0 And MyHzm < 256 Then
        If MyHzm = 32 Then GoTo er
        If Lower Then ChinesePronounce = ChinesePronounce + LCase(TmpStr) Else ChinesePronounce = ChinesePronounce + UCase(TmpStr):        GoTo er
    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
        If Lower Then ChinesePronounce = ChinesePronounce + "a" Else ChinesePronounce = ChinesePronounce + "A"
    ElseIf "B0C5" <= HzNm And HzNm <= "B2C0" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "b" Else ChinesePronounce = ChinesePronounce + "B"
    ElseIf "B2C1" <= HzNm And HzNm <= "B4ED" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "c" Else ChinesePronounce = ChinesePronounce + "C"
    ElseIf "B4EE" <= HzNm And HzNm <= "B6E9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "d" Else ChinesePronounce = ChinesePronounce + "D"
    ElseIf "B6EA" <= HzNm And HzNm <= "B7A1" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "e" Else ChinesePronounce = ChinesePronounce + "E"
    ElseIf "B7A2" <= HzNm And HzNm <= "B8C0" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "f" Else ChinesePronounce = ChinesePronounce + "F"
    ElseIf "B8C1" <= HzNm And HzNm <= "B9FD" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "g" Else ChinesePronounce = ChinesePronounce + "G"
    ElseIf "B9FE" <= HzNm And HzNm <= "BBF6" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "h" Else ChinesePronounce = ChinesePronounce + "H"
    ElseIf "BBF7" <= HzNm And HzNm <= "BFA5" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "j" Else ChinesePronounce = ChinesePronounce + "J"
    ElseIf "BFA6" <= HzNm And HzNm <= "C0AB" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "k" Else ChinesePronounce = ChinesePronounce + "K"
    ElseIf "C0AC" <= HzNm And HzNm <= "C2E7" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "l" Else ChinesePronounce = ChinesePronounce + "L"
    ElseIf "C2E8" <= HzNm And HzNm <= "C4C2" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "m" Else ChinesePronounce = ChinesePronounce + "M"
    ElseIf "C4C3" <= HzNm And HzNm <= "C5B5" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "n" Else ChinesePronounce = ChinesePronounce + "N"
    ElseIf "C5B6" <= HzNm And HzNm <= "C5BD" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "o" Else ChinesePronounce = ChinesePronounce + "O"
    ElseIf "C5BE" <= HzNm And HzNm <= "C6D9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "p" Else ChinesePronounce = ChinesePronounce + "P"
    ElseIf "C6DA" <= HzNm And HzNm <= "C8BA" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "q" Else ChinesePronounce = ChinesePronounce + "Q"
    ElseIf "C8BB" <= HzNm And HzNm <= "C8F5" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "r" Else ChinesePronounce = ChinesePronounce + "R"
    ElseIf "C8F6" <= HzNm And HzNm <= "CBF9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "s" Else ChinesePronounce = ChinesePronounce + "S"
    ElseIf "CBFA" <= HzNm And HzNm <= "CDD9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "t" Else ChinesePronounce = ChinesePronounce + "T"
    ElseIf "CDDA" <= HzNm And HzNm <= "CEF3" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "w" Else ChinesePronounce = ChinesePronounce + "W"
    ElseIf "CEF4" <= HzNm And HzNm <= "D188" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "x" Else ChinesePronounce = ChinesePronounce + "X"
    ElseIf "D1B9" <= HzNm And HzNm <= "D4D0" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "y" Else ChinesePronounce = ChinesePronounce + "Y"
    ElseIf "D4D1" <= HzNm And HzNm <= "D7F9" Then
        If Lower Then ChinesePronounce = ChinesePronounce + "z" Else ChinesePronounce = ChinesePronounce + "Z"
    Else
        ChinesePronounce = ChinesePronounce + HzNm
    End If
Next
er:
If Err.Number <> 0 Then ChinesePronounce = vbNullChar
End FunctionPrivate 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
Private Sub myDivide(num1 As Integer, num2 As Integer, Q As Integer, R As Integer)
If num2 = 0 Then Exit Sub
If num1 / num2 >= 0 Then
    Q = Int(num1 / num2)
Else
    Q = Int(num1 / num2) + 1
End If
R = num1 Mod num2
End Sub

Answer 6

这个是我用的。哈哈。 效率应该说还是比较高。
看起来也蛮简单的哈哈。
Public Function GetTextFirstLetter(strText As String) As String
'求出一字串的全部首字母
Dim t As Integer
Dim strTempLetters As String
For t = 1 To Len(strText)
    strTempLetters = strTempLetters + GetCharFirstLetter(Asc(Mid(strText, t, 1)))
Next
GetTextFirstLetter = strTempLetters
End FunctionPrivate Function GetCharFirstLetter(intChar As Integer) As String
'求出单个汉字的首字母，内部调用
'输入汉字asc码，输出首字母
Select Case intChar
Case Is >= 0:          GetCharFirstLetter = Chr(intChar)
Case Is >= -10246:     GetCharFirstLetter = " "
Case Is >= -11055:     GetCharFirstLetter = "Z"
Case Is >= -11847:     GetCharFirstLetter = "Y"
Case Is >= -12556:     GetCharFirstLetter = "X"
Case Is >= -12838:     GetCharFirstLetter = "W"
Case Is >= -13318:     GetCharFirstLetter = "T"
Case Is >= -14090:     GetCharFirstLetter = "S"
Case Is >= -14149:     GetCharFirstLetter = "R"
Case Is >= -14630:     GetCharFirstLetter = "Q"
Case Is >= -14914:     GetCharFirstLetter = "P"
Case Is >= -14922:     GetCharFirstLetter = "O"
Case Is >= -15165:     GetCharFirstLetter = "N"
Case Is >= -15640:     GetCharFirstLetter = "M"
Case Is >= -16212:     GetCharFirstLetter = "L"
Case Is >= -16474:     GetCharFirstLetter = "K"
Case Is >= -17417:     GetCharFirstLetter = "J"
Case Is >= -17922:     GetCharFirstLetter = "H"
Case Is >= -18239:     GetCharFirstLetter = "G"
Case Is >= -18526:     GetCharFirstLetter = "F"
Case Is >= -18710:     GetCharFirstLetter = "E"
Case Is >= -19218:     GetCharFirstLetter = "D"
Case Is >= -19775:     GetCharFirstLetter = "C"
Case Is >= -20283:     GetCharFirstLetter = "B"
Case Is >= -20319:     GetCharFirstLetter = "A"
Case Else:             GetCharFirstLetter = " "
End Select
End Function