汉字转拼音首字母，自定义函数，多方案对比

YZC51

zhonglet 发表于 2020-6-23 12:26
建议把“擦”改为“嚓”，因为看排序 嚓 字还在擦 字的前面的，如果不改的话，输入 嚓 的时候还是会显示  ...

谢谢老师指教！

yes363001640

谢谢分享，收藏了

缔造者

谢谢分享！

wxxydl

谢谢分享，收藏了

xvjiex

汉字转拼音首字母，自定义函数，多方案对比。很有创意！

ggmmlol

opiona 发表于 2020-6-21 22:32
如果全部是汉字  或字母,推荐:  5,6楼
如果包含有其他字符  例如日语,汉语:  5,6会出错    只能使用: 7楼! ...

其一，只对汉字取拼音首字母，使用Like运算符进行限定就好了。
其二，使用工作表函数LOOKUP从对照表中查取汉字的对应字母，无须声明"Option Compare Text"

1. Public Function PY_ZY$(str As String, Optional Ignore As Boolean = False)
   
2.     Dim i&, s$
   
3.     If Not IsArray(pyarr) Then pyarr = [{"吖","a";"八","b";"攃","c";"咑","d";"妸","e";"发","f";"旮","g";"哈","h";"丌","j";"咔","k";"垃","l";"妈","m";"拏","n";"噢","o";"帊","p";"七","q";"冄","r";"仨","s";"他","t";"屲","w";"夕","x";"丫","y";"帀","z"}]
   
4.     If Ignore Then str = LCase(str)
   
5.     str = Replace(str, " ", "")
   
6.     For i = 1 To Len(str)
   
7.         s = Mid(str, i, 1)
   
8.         If s Like "[一-龥]" Then
   
9.             If s = "长" Then s = "c" Else s = Application.Lookup(s, pyarr)
   
10.             If Ignore Then s = LCase(s)
    
11.             Mid(str, i, 1) = s
    
12.         End If
    
13.     Next
    
14.     PY_ZY = str
    
15. End Function

复制代码

CYZ凡星点点

谢谢分享,支持一下.

excel1202

我一直在用的拼音首字母，用作快速查询用途，效果很不错的：
Function PY(rng As String) As String
    Dim i As Integer, k As Integer, str As String
    If Len(rng) = 0 Then PY = "": Exit Function
    If Not IsNumeric(rng) Then
        str = xlapp.WorksheetFunction.Trim(rng)
        For i = 1 To Len(str)
            If Mid(str, i, 1) < "啊" Then
                PY = PY & Mid(str, i, 1)
            Else
                k = 1
                 Do Until Mid$("八嚓哒妸发旮铪讥讥咔垃妈拿哦妑七然仨他哇哇哇夕丫匝咗", k, 1) > Mid$(str, i, 1)
                    k = k + 1
                Loop
                PY = PY & Chr(64 + k)
            End If
        Next
    End If
End Function

excel1202

重复了，请版主删除

excel1202

重复了，请版主删除。