excel提取汉字首字母
在Excel表中实现取汉字首字母的功能
例子: 在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
Written on August 20, 2014