提取汉字的拼音
- 1、下载文档前请自行甄别文档内容的完整性，平台不提供额外的编辑、内容补充、找答案等附加服务。
- 2、"仅部分预览"的文档,不可在线预览部分如存在完整性等问题,可反馈申请退款(可完整预览的文档不适用该条件!)。
- 3、如文档侵犯您的权益，请联系客服反馈,我们会尽快为您处理(人工客服工作时间：9:00-18:30)。
使用方法，工具-宏-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
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