|
应该可以的.
贴上两个相关的函数,ALT+F11,新建一MODULE,然后COPY以下代码,再回工作表引用这两个函数就可以了.
'获取汉字拼音首字母
Public Function PY(Hzz As String) As String
Dim I As Integer, Hz1 As String, Hz As Long
For I = 1 To Len(Hzz)
Hz1 = Mid(Hzz, I, 1)
Hz = Asc(Hz1)
PY = PY & Switch(Hz < -20319, Hz1, Hz < -20283, "A", Hz < -19775, "B", Hz < -19218, "C", Hz < -18710, "D", _
Hz < -18526, "E", Hz < -18239, "F", Hz < -17922, "G", Hz < -17417, "H", Hz < -16474, "J", Hz < -16212, "K", _
Hz < -15640, "L", Hz < -15165, "M", Hz < -14922, "N", Hz < -14914, "O", Hz < -14630, "P", Hz < -14149, "Q", _
Hz < -14090, "R", Hz < -13318, "S", Hz < -12838, "T", Hz < -12556, "W", Hz < -11847, "X", Hz < -11055, "Y", _
Hz < -10246, "Z", Hz > -10247, Hz1)
Next
End Function
HZPY(String):返回汉字拼音首字母函数:
Function HZPY(hzstr As String) As String
Dim p0 As String, C As String, STR As String
Dim i As Integer, j As Integer
p0 = "吖八嚓咑妸发旮铪讥讥咔垃呣拿讴趴七呥仨他哇哇哇夕丫匝咗"
For i = 1 To Len(hzstr)
C = "z"
STR = Mid(hzstr, i, 1)
If Asc(STR) > 0 Then
C = STR
Else
For j = 1 To 26
If Mid(p0, j, 1) > STR Then
C = Chr(95 + j)
Exit For
End If
Next
End If
HZPY= HZPY+ C
Next
End Function |
|