excel中提取汉字的拼音首字母

下面是一个VBA自定义函数，按ALT＋F11，插入模块，在右面窗口中粘贴下面代码。

若B10内容为 中国航天6号a，则在某空白格中输入：=hztopy(B10) 即可

Function hztopy(hzpy As String) As String
  Dim hzstring As String, pystring As String
  Dim hzpysum As Integer, hzi As Integer, hzpyhex As Integer
  hzstring = Trim(hzpy)
  hzpysum = Len(Trim(hzstring))
  pystring = ""
  For hzi = 1 To hzpysum
    hzpyhex = "&H" + Hex(Asc(Mid(hzstring, hzi, 1)))
    Select Case hzpyhex
      Case &HB0A1 To &HB0C4: pystring = pystring + "A"
      Case &HB0C5 To &HB2C0: pystring = pystring + "B"
      Case &HB2C1 To &HB4ED: pystring = pystring + "C"
      Case &HB4EE To &HB6E9: pystring = pystring + "D"
      Case &HB6EA To &HB7A1: pystring = pystring + "E"
      Case &HB7A2 To &HB8C0: pystring = pystring &