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 = ""
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
Next i

PY = Test
End Function




'使用方法 使用vb编辑器 添加模块 粘贴以上内容 然后在需要显示的地方使用py(*) *=需要显示的内容
'此公式括号 字母和数字没有转换直接省略