excel汉字转换为拼音(只转换数字+中文)

Option Explicit
Function PY(MyStr As String) As String
Dim LenTest As Integer, i As Integer
Dim Test As String, TestStr As String
On Error Resume Next

MyStr = StrConv(MyStr, vbNarrow)
LenTest = Len(MyStr)

For i = 1 To LenTest
If Asc(Mid(MyStr, i, 1)) > 0 Or Err.Number = 1004 Then TestStr = ""
If (Asc(Mid(MyStr, i, 1)) >= 48 And Asc(Mid(MyStr, i, 1)) <= 57) Then
Test = Test & Mid(MyStr, i, 1)
GoTo aa1
End If
TestStr = Application.WorksheetFunction.Lookup(Mid(MyStr, i, 1), _
[{"吖","A";"八","B";"嚓","C";"咑","D";"鵽","E";"发","F";"猤","G";"铪","H";"夻","J";"咔","K";"垃","L";"嘸","M";"旀","N";"噢","O";"妑","P";"七","Q";"囕","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"}])
Test = Test & TestStr
aa1:
Next i

PY = Test
End Function