excl vba 汉字拼音首写字母

Sub pinyinszm()

Dim arr1, arr2

arr1 = Array("a", "b", "c", "d", "e", "f", "g", "h", "j", "k", "l", "m", "n", "o", "p", "q", "r", "s", "t", "w", "x", "y", "z")

arr2 = Array(-20319, -20285, -19777, -19220, -18712, -18528, -18241, -17924, -17419, -16476, -16214, -15642, -15167, -14924, -14916, -14632, -14151, -14092, -13121, -12840, -12558, -11849, -11057, -10248)

str1 = "中国人民"

If str1 = "" Then Exit Sub

lenstr1 = Len(str1)

jgzm = ""

For i = 1 To lenstr1

   s1 = Mid(str1, i, 1)

   aa = Asc(s1)

   If aa < arr2(0) Or aa > arr2(23) Then

      str2 = s1

   Else

      For i1 = 1 To 23

          If aa < arr2(i1) Then

              x = i1

              Exit For

          End If

      Next i1

      str2 = arr1(x - 1)

   End If

   jgzm = jgzm & str2

Next i

MsgBox jgzm

End Sub