在Excel表中实现取汉字首字母的功能

使用方法：

     工具-宏-visual basic编辑器，新建一个模块，然后将下列代码复印到模块中。然后，就可以把 pinyin(mystring)当一个工作薄函数来使用了。

例子：
在a1单元格中有文字 【阿中】
在b1单元格中输入函数  =pinyin(a1)  b1中则输出 【AZ】

代码：

Public Function pinyin(mystr As String) As Variant '自定义函数，目的：把单个汉字变为拼音的第一个字母。
    On Error Resume Next
    mystr = StrConv(mystr, vbNarrow)

    Dim returnStr As String

    Dim i As Integer
    Dim curWord As String
    For i = 1 To Len(mystr)

          curWord = Mid(mystr, i, 1)

          If Asc(curWord) <> 0 And Err.Number <> 1004 Then
            returnStr = returnStr & getFirstLetterOfCnWord(curWord)
          End If
    Next i

    pinyin = returnStr


End Function

 Public Function isCNWord(mystr As String) As Boolean
    Dim flag As Boolean
    flag = False
    If Len(mystr) <> LenB(mystr) Then
        flag = True
    End If
    isCNWord = flag
 End Function



Public Function getFirstLetterOfCnWord(mystr As String) As String
    If Asc(mystr) < 0 Then
        If Asc(Left$(mystr, 1)) < Asc("啊") Then
            getFirstLetterOfCnWord = "0"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("啊") And Asc(Left$(mystr, 1)) < Asc("芭") Then
            getFirstLetterOfCnWord = "A"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("芭") And Asc(Left$(mystr, 1)) < Asc("擦") Then
            getFirstLetterOfCnWord = "B"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("擦") And Asc(Left$(mystr, 1)) < Asc("搭") Then
            getFirstLetterOfCnWord = "C"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("搭") And Asc(Left$(mystr, 1)) < Asc("蛾") Then
            getFirstLetterOfCnWord = "D"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("蛾") And Asc(Left$(mystr, 1)) < Asc("发") Then
            getFirstLetterOfCnWord = "E"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("发") And Asc(Left$(mystr, 1)) < Asc("噶") Then
            getFirstLetterOfCnWord = "F"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("噶") And Asc(Left$(mystr, 1)) < Asc("哈") Then
            getFirstLetterOfCnWord = "G"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("哈") And Asc(Left$(mystr, 1)) < Asc("击") Then
            getFirstLetterOfCnWord = "H"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("击") And Asc(Left$(mystr, 1)) < Asc("喀") Then
            getFirstLetterOfCnWord = "J"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("喀") And Asc(Left$(mystr, 1)) < Asc("垃") Then
            getFirstLetterOfCnWord = "K"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("垃") And Asc(Left$(mystr, 1)) < Asc("妈") Then
            getFirstLetterOfCnWord = "L"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("妈") And Asc(Left$(mystr, 1)) < Asc("拿") Then
            getFirstLetterOfCnWord = "M"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("拿") And Asc(Left$(mystr, 1)) < Asc("哦") Then
            getFirstLetterOfCnWord = "N"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("哦") And Asc(Left$(mystr, 1)) < Asc("啪") Then
            getFirstLetterOfCnWord = "O"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("啪") And Asc(Left$(mystr, 1)) < Asc("期") Then
            getFirstLetterOfCnWord = "P"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("期") And Asc(Left$(mystr, 1)) < Asc("然") Then
            getFirstLetterOfCnWord = "Q"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("然") And Asc(Left$(mystr, 1)) < Asc("撒") Then
            getFirstLetterOfCnWord = "R"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("撒") And Asc(Left$(mystr, 1)) < Asc("塌") Then
            getFirstLetterOfCnWord = "S"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("塌") And Asc(Left$(mystr, 1)) < Asc("挖") Then
            getFirstLetterOfCnWord = "T"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("挖") And Asc(Left$(mystr, 1)) < Asc("昔") Then
            getFirstLetterOfCnWord = "W"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("昔") And Asc(Left$(mystr, 1)) < Asc("压") Then
            getFirstLetterOfCnWord = "X"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("压") And Asc(Left$(mystr, 1)) < Asc("匝") Then
            getFirstLetterOfCnWord = "Y"
            Exit Function
        End If
        If Asc(Left$(mystr, 1)) >= Asc("匝") Then
            getFirstLetterOfCnWord = "Z"
            Exit Function
        End If
    Else
        If UCase$(mystr) <= "Z" And UCase$(mystr) >= "A" Then
            getFirstLetterOfCnWord = UCase$(Left$(mystr, 1))
        Else
            getFirstLetterOfCnWord = mystr
        End If
    End If
End Function