Excel-VBA自定义函数取姓名的汉语拼音首字母

应用场景

用函数取汉语拼音的首字母

知识要点

1：Option Compare语句，设置缺省的字符比较方法，只能在模块级使用，语法Option Compare {Binary | Text | Database}

 Option Compare Binary ,按排序顺序进行字符串比较A<B<C<a<b<?等，Option Compare text 不区分大小写进行字符串比较A=a

2：将所有拼音首字母相同的第一个汉字取出来组成一个字符串，例如拉、洛、梁等，拉=la最靠前，取拉

3：将参数中的每个字符与参照字符串中每个比较，统计参照字符串中有多少字符小于参数中的字符，如果有10个，通过chr函数，转换成第9个英文字符J，非汉字保持不变

Option Compare Text '比较方式为text

'声明函数PY，有一个必选参数，为特引用的单元格或者字符串

Function PY(Rng As Range)

    Application.Volatile '声明为易失性函数

    Dim i As Integer, k As Integer, Str As String

    If Len(Rng) = 0 Then PY = '': Exit Function '如果引用单元格空白，则返回空文本

    If Not IsNumeric(Rng) Then '如果不是数值

        Str = WorksheetFunction.Trim(Rng)  '去除空格格后，赋予变量str

        For i = 1 To Len(Str)   '遍历所有字符

            If Mid(Str, i, 1) < '啊' Then '如果小于  啊  ，表示不是汉字

                PY = PY & Mid(Str, i, 1) '保留原字符不变

            Else

                k = 1

            '将字符串中每个字符与参数中的字符进行比较，统计字符串中大于参数中的字符的个数，得到变量 k

                Do Until Mid$('八嚓哒妸发旮铪讥讥咔垃妈拿哦妑七然仨他哇哇哇夕丫匝咗', k, 1) > Mid$(Str, i, 1)

                    k = k 1

                Loop

                PY = PY & Chr(64 k) '根据K值得到大写的英文字母(chr(65)为第一个字母A

            End If

        Next

    End If

End Function