Excel 提取姓名拼音首字母

Option Explicit
Function PY(TT As String) As Variant '自定義函數，目的：把一組漢字變為一組漢字拼音的第一個字母。
Dim i%, temp$
    PY = ""
    For i = 1 To Len(TT)
         temp = Asc(Mid$(TT, i, 1))
         If temp > 255 Or temp < 0 Then   '是漢字嗎？
             PY = PY & pinyin(Mid$(TT, i, 1)) '轉化為拼音首字母，
         Else
             PY = PY & LCase(Mid$(TT, i, 1))  '轉化英文字母
         End If
    Next i
End Function
Function pinyin(myStr As String) As Variant '自定義函數，目的：把單個漢字變為拼音的第一個字母。
    On Error Resume Next
    myStr = StrConv(myStr, vbNarrow)
    If Asc(myStr) > 0 Or Err.Number = 1004 Then pinyin = ""
    pinyin = Application.WorksheetFunction.VLookup(myStr, [{"吖","A";"八","B";"嚓","C";"咑","D";"鵽","E";"發","F";"猤","G";"鉿","H";"夻","J";"咔","K";"垃","L";"嘸","M";"旀","N";"噢","O";"妑","P";"七","Q";"囕","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"}], 2)
End Function

來源於網絡，引用不詳。