VBA中如何自定义取得汉字拼音的第一个字母函数？

楼主 gvntw	提取拼音首字母的自定义函数，如“大海航行靠舵手”提取“DHHXKDS”。 Option Explicit Function PY(myStr As String) As String Dim LenInt As Integer, i As Integer Dim Temp As String, oStr As String On Error Resume Next myStr = StrConv(myStr, vbNarrow) LenInt = Len(myStr) For i = 1 To LenInt If Asc(Mid(myStr, i, 1)) > 0 Or Err.Number = 1004 Then oStr = "" oStr = Application.WorksheetFunction.Lookup(Mid(myStr, i, 1), _ 拼音首字母.zip
2楼 apolloh	发哥万岁！FGWS呵呵！
3楼罗刚君	简化一下： Function PY(myStr As String) As String Dim i As Integer For i = 1 To Len(myStr) If Mid(myStr, i, 1) Like "[一-龥]" Then PY = PY & Application.WorksheetFunction.Lookup(Mid(myStr, i, 1), [{"吖","A";"八","B";"嚓","C";"咑","D";"鵽","E";"发","F";"猤","G";"铪","H";"夻","J";"咔","K";"垃","L";"嘸","M";"旀","N";"噢","O";"妑","P";"七","Q";"囕","R";"仨","S";"他","T";"屲","W";"夕","X";"丫","Y";"帀","Z"}]) Next i End Function
4楼 gvntw	谢谢罗兄简化！输入靔靝埊肏也能求出。另：请问所有汉字都包含“在一-龥”间吗？
5楼水星钓鱼	”“这个看看能不能出来？呵呵
6楼 superzyp	高人你好为什么我第一次测试可以第二次就无法输出了，输出显示：#NAME? 是哪里出了问题，请指教，谢谢
7楼 BIN_YANG168	这里的比较全面： http://www.exceltip.net/thread-1861-1-3.html
8楼 tongliaozyr	越学习，越发现自已的无知！
9楼 wise	Q：VBA中如何自定义取得汉字拼音的第一个字母函数？ A：翻了一下以前的学习资料，找出这样一个收藏的一个帖子，发上来。觉得这个帖子的代码不错。这个自定义函数不错。 Public Function GetPinY(myChar As String) As String Dim i As Long i = Asc(myChar) If i >= Asc("啊") And i < Asc("芭") Then GetPinY = "A" ElseIf i >= Asc("芭") And i < Asc("擦") Then GetPinY = "B" ElseIf i >= Asc("擦") And i < Asc("搭") Then GetPinY = "C" ElseIf i >= Asc("搭") And i < Asc("蛾") Then GetPinY = "D" ElseIf i >= Asc("蛾") And i < Asc("发") Then GetPinY = "E" ElseIf i >= Asc("发") And i < Asc("噶") Then GetPinY = "F" ElseIf i >= Asc("噶") And i < Asc("哈") Then GetPinY = "G" ElseIf i >= Asc("哈") And i < Asc("击") Then GetPinY = "H" ElseIf i >= Asc("击") And i < Asc("喀") Then GetPinY = "J" ElseIf i >= Asc("喀") And i < Asc("垃") Then GetPinY = "K" ElseIf i >= Asc("垃") And i < Asc("妈") Then GetPinY = "L" ElseIf i >= Asc("妈") And i < Asc("拿") Then GetPinY = "M" ElseIf i >= Asc("拿") And i < Asc("哦") Then GetPinY = "N" ElseIf i >= Asc("哦") And i < Asc("啪") Then GetPinY = "O" ElseIf i >= Asc("啪") And i < Asc("欺") Then GetPinY = "P" ElseIf i >= Asc("欺") And i < Asc("然") Then GetPinY = "Q" ElseIf i >= Asc("然") And i < Asc("撒") Then GetPinY = "R" ElseIf i >= Asc("撒") And i < Asc("塌") Then GetPinY = "S" ElseIf i >= Asc("塌") And i < Asc("挖") Then GetPinY = "T" ElseIf i >= Asc("挖") And i < Asc("昔") Then GetPinY = "W" ElseIf i >= Asc("昔") And i < Asc("压") Then GetPinY = "X" ElseIf i >= Asc("压") And i < Asc("匝") Then GetPinY = "Y" ElseIf i >= Asc("匝") And i <= Asc("座") Then GetPinY = "Z" End If End Function
10楼 gvntw	提取汉字拼音首字母，我以前发过一帖了： http://www.exceltip.net/thread-1215-1-1.html
11楼 dtxczjzmp	收下，谢谢多位高手分享！
12楼逍遥自在