查看: 8186|回复: 12
【取汉字拼音首字母自定义函数】
阅读权限50
在线时间 小时
& & & & & & & &
本帖已被收录到知识树中，索引项：
列举出所有的汉字,在一个一个匹配。方法有的笨,但是可以适合所有汉字。有些偏的汉字,大家可以自己加进去。
Option Explicit
'功能:取汉字拼音首字母函数
'参数:as_data 要提取的汉字
'返回:汉字拼音首字母
Sub test()
&&MsgBox f_get_py(&张元光宏通VBA软件工作室&) '字、词、句
Sub test1()
&&MsgBox f_get_py(&Y&) '字母数字测试
Sub test2()
&&MsgBox hz2py(&张&) '一个字
Public Function f_get_py(ByVal as_data As String) As String
Dim ll_pos As Long
Dim ls_py As String
Dim ls_pos As String
& & For ll_pos = 1 To Len(as_data)
& && &&&If Mid(as_data, ll_pos, 1) & 128 Then
& && && &&&ls_py = ls_py + hz2py(Mid(as_data, ll_pos, 1))
& && &&&Else
& && && &&&ls_py = ls_py + Mid(as_data, ll_pos, 1)
& && &&&End If
f_get_py = ls_py
End Function
Public Function hz2py(ByVal hz As String) As String
& & Dim str1 As String
& & '====================================以A开头的汉字======================================
& & str1 = &啊阿呵吖嗄腌锕錒&
& & str1 = str1 & &爱矮挨哎碍癌艾唉哀蔼隘埃皑呆嗌嫒瑷暧捱砹嗳锿霭乃剀呃噫奇阂乂伌僾儗凒剴叆呝啀嘊噯堨塧壒娭娾嬡嵦愛懓懝敱敳昹曖欬欸毐溰溾濭烠焥璦皚皧瞹硋磑礙絠薆藹諰譪譺賹躷醷鎄鑀閡阨阸隑靄靉餲馤騃鯦鱫鴱&
& & str1 = str1 & &按安暗岸俺案鞍氨胺厂广庵揞犴铵桉谙鹌埯黯干盒钳顸侒儑匼厈咹唵啽垵垾堓婩媕屽峖晻洝玵痷盦盫碪罯腤荌菴萻葊蓭裺誝諳豻貋遃鉗銨錌闇陰隂隌雸鞌韽頇頞馣鮟鴳鵪鶕&
& & str1 = str1 & &昂肮盎仰卬岇昻枊醃醠骯&
& & str1 = str1 & &袄凹傲奥熬懊敖翱澳嚣拗媪廒骜嗷坳遨聱螯獒鏊鳌鏖岙噢棍浇厫嗸嚻囂垇墺墽奡奧媼嫯岰嶅嶴慠扷抝摮擙柪梎泑滶澆澚熝爊獓璈眑磝磽礉翶翺芺蔜蝹襖謷謸軪郩鏕镺隞驁鰲鴁鴢鷔鼇& & &
& & If InStr(1, str1, hz, vbTextCompare) &= 1 Then
& && &&&hz2py = &A&
& && &&&Exit Function
& & End If
& & str1 = &&
& & '====================================以B开头的汉字======================================&
& & str1 = &把八吧爸拔罢跋巴芭扒坝霸叭靶笆疤耙捌粑茇岜鲅钯魃菝灞伯捭杷湃萆仈叐哱哵坺垻墢壩夿妭峇弝抜抪朳柭欛炦犮玐癹皅矲笩紦罷羓胈茷蚆覇詙豝跁軷釛釟鈀颰魞鮁鮊鲃鲌鼥把八吧爸拔罢跋巴芭扒坝霸叭靶笆疤耙捌粑茇岜鲅钯魃菝灞伯捭杷湃萆仈叐哱哵坺垻墢壩夿妭峇弝抜抪朳柭欛炦犮玐癹皅矲笩紦罷羓胈茷蚆覇詙豝跁軷釛釟鈀颰魞鮁鮊鲃鲌鼥&
& & str1 = str1 & &百白摆败柏拜佰伯稗捭呗掰扒排派薜鞴唄庍拝挀擺敗栢猈竡粨粺絔薭襬贁鞁韛&
& & str1 = str1 & &半办班般拌搬版斑板伴扳扮瓣颁绊癍坂钣舨阪瘢分彬豳辨辩並坢埿姅岅怑搫攽斒昄朌柈湴瓪秚籓粄絆肦蝂螁螌褩覂跘辦辧辬辯鈑鉡闆靽頒魬鳻&
& & str1 = str1 & &帮棒绑磅镑邦榜蚌傍梆膀谤浜蒡彭旁纺螃並嗙垹埲塝嫎峀崗幇幚幫徬挷捠搒棓牓玤硥稖紡綁縍艕蚄蛖蜯謗邫鎊鞤騯髈&
& & str1 = str1 & &包抱报饱保暴薄宝爆剥豹刨雹褒堡苞胞鲍炮瀑龅孢煲褓鸨趵葆勹呆簿袍裒佨儤剝勽嘐嚗堢報媬嫑寚寳寶忁怉曓枹珤砲窇笣緥菢蕔藵虣蚫袌裦襃賲鉋鑤铇闁靌靤飹飽駂骲髱鮑鳵鴇齙&
& & str1 = str1 & &萡&
& & str1 = str1 & &被北倍杯背悲备碑卑贝辈钡焙狈惫臂褙悖蓓鹎鐾呗邶鞴孛陂碚俾埤怫波菩萆葡蜚跋俻偝偹備僃哱唄喺垻愂憊揹昁杮柸桮梖棑棓椑牬犕狽珼琲痺盃禙箃糒苝茀萯藣蛽襬誖諀貝軰輩鄁鉳鋇錍鐴骳鵯&
& & str1 = str1 & &本奔苯笨夯锛贲畚坌体倴喯夲奙捹撪桳楍泍渀炃燌犇獖翉蟦賁輽逩錛鐼&
& & str1 = str1 & &蹦绷甭崩迸蚌泵甏嘣俸傍唪堋平抨旁榜伻傰嗙埄埲塴奟嵭挷搒漨熢琣琫痭祊絣綳繃菶跰逬錋鏰镚閍鞛&
& & str1 = str1 & &比笔闭鼻碧必避逼毕臂彼鄙壁蓖币弊辟蔽毙庇敝陛毖痹秘泌秕薜荸芘萆匕裨畀俾嬖狴筚箅篦舭荜襞庳铋跸吡愎贲滗濞璧哔髀弼妣婢仳佛卑埤复媲幅庀拂捭服枇檗殍波瞥纰脾虑被费跛鐾陂陴馥佊佖偪匂咇啚嗶坒堛夶奰妼娝嬶屄崥幣幤廦弻彃怭怶悂愊斃旇朼枈柀柲梐椑楅毴沘湢滭潷煏熚獘獙珌畁畐畢疕疪痺皀皕禆稫笓筆箃箄箆篳粃粊紕紴綼縪繴罷罼翍聛肶肸胇腗腷苾萞蓽蘗蜌螕袐襅襣觱詖诐豍貏貱費賁贔赑踾蹕躃躄邲鄨鄪鈚鉍錍鎞鏎鐴閇閈閉閟闬鞁鞞鞸韠飶饆馝駜驆髲魓魮鮅鮩鰏鲾鴓鵖鶝鷝鷩鸊鼊&
& & str1 = str1 & &边变便遍编辩扁贬鞭卞辨辫忭砭匾汴碥蝙褊鳊笾苄窆弁髟缏煸封拚稹変峅徧惼抃揙昪汳炞牑猵獱甂疺稨箯籩糄編緶臱艑萹藊覍覵變豍貶辡辦辧辮辯邉邊邲釆鍽閞鞕頨鯾鯿鴘鶣&
& & str1 = str1 & &表标彪膘杓婊飑飙鳔瘭飚镳裱骠镖剽嫖漂灬苞鏖髟俵僄儦墂幖徱摽標檦淲滮瀌熛爂猋穮篻脿膔臕蔈藨褾諘謤贆錶鏢鑣颮颷飆飇飈飊驃驫骉鰾麃&
& & str1 = str1 & &别憋鳖瘪蹩扒拔捌撇秘蔽別咇彆徶撆柭柲猰癟穪苾莂虌蛂蟞襒鱉鼈龞&
& & str1 = str1 & &宾濒摈彬斌滨豳膑殡缤髌傧槟鬓镔玢份浜频儐擯椕殯氞汃濱濵瀕瑸璸砏繽臏虨蠙訜豩賓賔贇赟邠鑌霦頻顮髕髩鬂鬢&
& & str1 = str1 & &并病兵冰丙饼屏秉柄炳摒槟禀邴冫平拼枋燹绠並仌併倂偋傡垪寎幷庰怲抦掤昞昺栟栤梹棅檳氷燷琕痭癛癝眪稟窉竝絣綆苪蛃誁跰鈵鉼鋲陃靐鞆鞞鞸餅餠鮩&
& & str1 = str1 & &拨波播泊博伯驳玻剥薄勃菠钵搏脖帛般柏舶渤铂箔膊魄卜礴跛檗亳鹁踣啵蕃簸钹饽擘佛募孛怕拍拔擗暴服泼潘瀑爆番白百簿艴菩蒲薜蘖趵跑鲅仢侼僠僰剝哱噃嚗壆妭孹嶓帗彴愽懪挬撥柭桲榑檘欂殕浡淿湐潑煿牔犦犻狛猼瓝瓟癶發皪盋砵碆磻礡秡穛笩箥簙糪紴缽肑胉艊苩茀茷葧蔔蔢蘗蚾袚袯袹襎襏襮詙譒豰蹳郣鈸鉑鉢鋍鎛鑮镈餑餺馎馛馞駁駮驋髆髉鮁鮊鱍鲌鵓&
& & str1 = str1 & &不步补布部捕卜簿哺堡埠怖埔瓿逋晡钸钚醭卟拊溥薄附鞴佈僕勏吥咘埗婄尃峬庯廍悑抪捗捬撲擈柨歨歩獛秿箁篰荹蔀補誧踄輹轐郶鈈鈽陠餔餢鯆鳪鵏鸔&
& & If InStr(1, str1, hz, vbTextCompare) &= 1 Then
& && &&&hz2py = &B&
& && &&&Exit Function
& & End If
& & str1 = &&
(52.57 KB, 下载次数: 659)
11:39 上传
点击文件名下载附件
知识树索引：这个方法是唯一正确的。&
不一般的耐心
阅读权限30
在线时间 小时
先下载测试
阅读权限100
在线时间 小时
...确实很强悍...
阅读权限30
在线时间 小时
& & & & & & & &
确实有点笨，还不能有多音字，把守柔的代码库弄过来更好，呵呵
阅读权限20
在线时间 小时
不错，笨是笨点，不过很实用哦！谢谢楼主
阅读权限50
在线时间 小时
'注：只翻译【最佳答案】和【疑问】帖
Function 拼音首字母(ByVal R As Range) As String
& & Const hanzi = &啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座ABCDEFGHJKLMNOPQRSTWXYZZ&
& & Dim i As Integer, j As Integer, temp As String
& & For i = 1 To Len(R)
& && &&&temp = Mid(R, i, 1)
& && &&&If temp && & & And Asc(temp) & 0 Then
& && && && &If temp = &座& Then temp = &Z&
& && && && &For j = 1 To 23
& && && && && & If Asc(temp) &= Asc(Mid(hanzi, j, 1)) And Asc(temp) & Asc(Mid(hanzi, j + 1, 1)) Then temp = Mid(hanzi, 24 + j, 1)
& && && && &Next
& && && && &PY = PY & temp
& && &&&End If
& & 拼音首字母 = UCase(PY)
End Function
函数 拼音首字母(传值变量 r 为 单元格区域) 为 字符串
& & 常数 hanzi = &啊芭擦搭蛾发噶哈击喀垃妈拿哦啪期然撒塌挖昔压匝座abcdefghjklmnopqrstwxyzz&
& & 定义变量 i 为 整型值 ,j 为 整型值 ,临时 为 字符串
& & 循环范围 i = 1 到 字符串长度(r)
& && &&&临时 = 截取字符串(r ,i ,1)
& && &&&如果 临时&&& & 并且 字符转数值(临时) & 0 那么
& && && && &如果 临时 = &座& 那么 临时 = &z&
& && && && &循环范围 j = 1 到 23
& && && && && & 如果 字符转数值(临时)&&&=&&字符转数值(截取字符串(hanzi ,j ,1)) 并且 字符转数值(临时) & 字符转数值(截取字符串(hanzi ,j + 1 ,1)) 那么 临时 = 截取字符串(hanzi ,24 + j ,1)
& && && && &下一句
& && && && &py = py & 临时
& && &&&结束 如果
& & 下一句
& & 拼音首字母 = ucase(py)
看翻译的，头晕，还是原来的好看。&
阅读权限50
在线时间 小时
win2009 发表于
'注：只翻译【最佳答案】和【疑问】帖
很简捷啊，谢谢
阅读权限95
在线时间 小时
& & & & & & & &
6楼的代码好象不能针对扩展字库里的文字。楼主的代码虽然制作起来很麻烦，但扩展性较好，我用“皛(xiao,jiao)”字测试了一下，楼主好象放错位置了，在P里面也有这个字了。
阅读权限10
在线时间 小时
字库错误太多了！ 没有意义！.............
阅读权限50
在线时间 小时
今天用到这个功能，试了一下，错误确实有点多。。。。。。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师excel中如何实现提取汉字的拼音首字母_百度知道
该问题可能描述不清，建议你
excel中如何实现提取汉字的拼音首字母
我有更好的答案
步骤：第一步、启动Excel 2003（其它版本请仿照操作），打开相应的工作表；第二步、执行“工具→宏→Visual Basic编辑器”命令（或者直接按“Alt+F11”组合键），进入Visual Basic编辑状态；第三步、执行“插入→模块”命令，插入一个新模块。再双击插入的模块，进入模块代码编辑状态；第四步、将代码输入其中；Function pinyin(p As String) As Stringi = Asc(p)Select Case iCase -20319 To -20284: pinyin = &A&Case -20283 To -19776: pinyin = &B&Case -19775 To -19219: pinyin = &C&Case -19218 To -18711: pinyin = &D&Case -18710 To -18527: pinyin = &E&Case -18526 To -18240: pinyin = &F&Case -18239 To -17923: pinyin = &G&Case -17922 To -17418: pinyin = &H&Case -17417 To -16475: pinyin = &J&Case -16474 To -16213: pinyin = &K&Case -16212 To -15641: pinyin = &L&Case -15640 To -15166: pinyin = &M&Case -15165 To -14923: pinyin = &N&Case -14922 To -14915: pinyin = &O&Case -14914 To -14631: pinyin = &P&Case -14630 To -14150: pinyin = &Q&Case -14149 To -14091: pinyin = &R&Case -14090 To -13319: pinyin = &S&Case -13318 To -12839: pinyin = &T&Case -12838 To -12557: pinyin = &W&Case -12556 To -11848: pinyin = &X&Case -11847 To -11056: pinyin = &Y&Case -11055 To -2050: pinyin = &Z&Case Else: pinyin = pEnd SelectEnd FunctionFunction getpy(str)For i = 1 To Len(str)getpy = getpy & pinyin(Mid(str, i, 1))Next iEnd Function第五步、代码输入完成后，关闭Visual Basic编辑窗口，返回Excel编辑状态；第六步、自定义函数就可以用了，如：选中A2单元格，输入公式：=getpy(A2)。
采纳率：75%
后面又提的问题，手工做只需选中ZGHT6Ha这一列复制，再另一列选择性粘贴－＞数值，再改就行了。下面是一个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 + &F&
Case &HB8C1 To &HB9FD: pystring = pystring + &G&
Case &HB9FE To &HBBF6: pystring = pystring + &H&
Case &HBBF7 To &HBFA5: pystring = pystring + &J&
Case &HBFA6 To &HC0AB: pystring = pystring + &K&
Case &HC0AC To &HC2E7: pystring = pystring + &L&
Case &HC2E8 To &HC4C2: pystring = pystring + &M&
Case &HC4C3 To &HC5B5: pystring = pystring + &N&
Case &HC5B6 To &HC5BD: pystring = pystring + &O&
Case &HC5BE To &HC6D9: pystring = pystring + &P&
Case &HC6DA To &HC8BA: pystring = pystring + &Q&
Case &HC8BB To &HC8F5: pystring = pystring + &R&
Case &HC8F6 To &HCBF9: pystring = pystring + &S&
Case &HCBFA To &HCDD9: pystring = pystring + &T&
Case &HEDC5: pystring = pystring + &T&
Case &HCDDA To &HCEF3: pystring = pystring + &W&
Case &HCEF4 To &HD1B8: pystring = pystring + &X&
Case &HD1B9 To &HD4D0: pystring = pystring + &Y&
Case &HD4D1 To &HD7F9: pystring = pystring + &Z&
pystring = pystring + Mid(hzstring, hzi, 1)
End Select
hztopy = pystringEnd Function
本回答被提问者和网友采纳
分两步1、取得拼音得用到VBA打开Excel-&工具-&宏-&Viaual Basic编辑器在弹出来的窗口中对着VBAproject点右键-&插入-&模块下面会出现一个名为&模块1&，点击在右边的空白栏中粘贴以下内容：Function getpychar(char)tmp = 65536 + Asc(char)If (tmp &= 45217 And tmp &= 45252) Thengetpychar = &A&ElseIf (tmp &= 45253 And tmp &= 45760) Thengetpychar = &B&ElseIf (tmp &= 45761 And tmp &= 46317) Thengetpychar = &C&ElseIf (tmp &= 46318 And tmp &= 46825) Thengetpychar = &D&ElseIf (tmp &= 46826 And tmp &= 47009) Thengetpychar = &E&ElseIf (tmp &= 47010 And tmp &= 47296) Thengetpychar = &F&ElseIf (tmp &= 47297 And tmp &= 47613) Thengetpychar = &G&ElseIf (tmp &= 47614 And tmp &= 48118) Thengetpychar = &H&ElseIf (tmp &= 48119 And tmp &= 49061) Thengetpychar = &J&ElseIf (tmp &= 49062 And tmp &= 49323) Thengetpychar = &K&ElseIf (tmp &= 49324 And tmp &= 49895) Thengetpychar = &L&ElseIf (tmp &= 49896 And tmp &= 50370) Thengetpychar = &M&ElseIf (tmp &= 50371 And tmp &= 50613) Thengetpychar = &N&ElseIf (tmp &= 50614 And tmp &= 50621) Thengetpychar = &O&ElseIf (tmp &= 50622 And tmp &= 50905) Thengetpychar = &P&ElseIf (tmp &= 50906 And tmp &= 51386) Thengetpychar = &Q&ElseIf (tmp &= 51387 And tmp &= 51445) Thengetpychar = &R&ElseIf (tmp &= 51446 And tmp &= 52217) Thengetpychar = &S&ElseIf (tmp &= 52218 And tmp &= 52697) Thengetpychar = &T&ElseIf (tmp &= 52698 And tmp &= 52979) Thengetpychar = &W&ElseIf (tmp &= 52980 And tmp &= 53640) Thengetpychar = &X&ElseIf (tmp &= 53689 And tmp &= 54480) Thengetpychar = &Y&ElseIf (tmp &= 54481 And tmp &= 62289) Thengetpychar = &Z&Else '如果不是中文，则不处理getpychar = charEnd IfEnd FunctionFunction getpy(str)For i = 1 To Len(str)getpy = getpy & getpychar(Mid(str, i, 1))Next iEnd Function按ALT+F11回到EXCEL2、如果你的表如下A B C D1 姓名 出生年月 工作时间2 刘德华 在D2单元格输入公式=getpy(A2)&right(B2,2)&right(C2,2)
为您推荐：
其他类似问题
excel的相关知识
换一换
回答问题，赢新手礼包
个人、企业类
违法有害信息,请在下方选择后提交
色情、暴力
我们会通过消息、邮箱等方式尽快将举报结果通知您。查看: 6713|回复: 6
如何提取每个汉字的首写字母
阅读权限10
在线时间 小时
& & & & & & & &
用函数总会有部分字出错
有没有更好点的方法
例如有5000列字要提取首写字母 我想搜集下这5000列中多少个相同的字然后在每个定义下这些字的首写字母然后在用函数将根据我定义的首写字母来列出每个字的首写字
好朋友爱情冲冲冲
阅读权限95
在线时间 小时
用助记码，取第1个即可，给你这个论坛中的高手的作品，其实自己搜一下全有了................................
(17.68 KB, 下载次数: 245)
15:19 上传
点击文件名下载附件
阅读权限10
在线时间 小时
cmxxccxx 发表于
用助记码，取第1个即可，给你这个论坛中的高手的作品，其实自己搜一下全有了............................. ...
(2.71 KB, 下载次数: 45)
15:28 上传
点击文件名下载附件
例如我想将这个文件中的第一列提取出相同的字 我在定义下每个字的首写字母&&然后在 根据我定义的首写字母在B列列出每个字的首写字母
阅读权限95
在线时间 小时
(21.71 KB, 下载次数: 66)
15:45 上传
点击文件名下载附件
，因为这个是自定义函数，因此需要将工具-宏-安全性设置为低，另外你的电脑系统中必须装有微软拼音版本
阅读权限10
在线时间 小时
cmxxccxx 发表于
，因为这个是自定义函数，因此需要将工具-宏-安全性设置为低，另外你的电脑系统中必须装有微软拼音版本
要每个字的首写字母不是没列的首写字母如何设置
阅读权限95
在线时间 小时
lcc87 发表于
要每个字的首写字母不是没列的首写字母如何设置
你的意思是一句话，取这句话的每个字的首写字母？那就麻烦点，做是能做的，直接编VB处理，但有什么意义。。。。。。
阅读权限20
在线时间 小时
再分享一个代码，留着自已以后用。提取汉字拼音首字母的VBA代码：
Option Explicit
Function PY(TT As String) As Variant '自定义函数，目的：把一组汉字变为一组汉字拼音的第一个字母。
Dim i%, temp$
& & PY = &&
& & For i = 1 To Len(TT)
& && && &temp = Asc(Mid$(TT, i, 1))
& && && &If temp & 255 Or temp & 0 Then& &'是汉字吗？
& && && && & PY = PY & pinyin(Mid$(TT, i, 1)) '转化为拼音首字母，
& && && &Else
& && && && & PY = PY & LCase(Mid$(TT, i, 1))&&'转化英文字母
& && && &End If
& & Next i
End Function
Function pinyin(myStr As String) As Variant '自定义函数，目的：把单个汉字变为拼音的第一个字母。
& & On Error Resume Next
& & myStr = StrConv(myStr, vbNarrow)
& & If Asc(myStr) & 0 Or Err.Number = 1004 Then pinyin = &&
& & pinyin = Application.WorksheetFunction.VLookup(myStr, [{&吖&,&A&;&八&,&B&;&嚓&,&C&;&咑&,&D&;&鵽&,&E&;&发&,&F&;&猤&,&G&;&铪&,&H&;&夻&,&J&;&咔&,&K&;&垃&,&L&;&嘸&,&M&;&旀&,&N&;&噢&,&O&;&妑&,&P&;&七&,&Q&;&囕&,&R&;&仨&,&S&;&他&,&T&;&屲&,&W&;&夕&,&X&;&丫&,&Y&;&帀&,&Z&}], 2)
End Function
　　使用方法是：打开excel文档，按下ALT+F11，打开VBE编辑器，然后插入——模块，复制上面的代码，关闭VBE。回到工作表中，输入公式，比如：=py(A2)，就可以提取A2单元格汉字拼音首字母。
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师查看: 3170|回复: 4
请问如何提取中文拼音第一个字母？
阅读权限20
在线时间 小时
excel：A列为中文汉字，想在B列提取A列每个汉字第一个字母。
先谢谢哈！
在线时间 小时
〖Excel Home友情提示〗
很遗憾通知楼上朋友，您的帖子在24小时之内没有任何回复！
通常情况下，本论坛发布的主题帖会在8小时被回复或处理。您的帖子在24小时之内未被回复，其中的原因可能是：
1、问题表述不清、模棱两可，难以理解，帮助者被搞晕了，夺帖而出；
2、没有上传必要的附件，或附件被遗忘在某个角落；
3、发帖提问时，语气带棱角、带挑衅，不幸被列入不受欢迎的帖子；
4、所提问题不成立，或提不合理的要求，乐于助人者使出“走为上”之计；
5、话题较偏、较冷或者发布到了不合适的版块，暂时无人问津，顾影自怜。
为了提高您的问题解决效率，我们推荐您阅读以下文章：
* 如何发表新话题和上传附件：
* 发帖的技巧：
* EH技术论坛的最佳学习方法：
阅读权限100
在线时间 小时
前人的自定义函数
Function PY(TT As String) As Variant '自定义函数，目的：把一组汉字变为一组汉字拼音的第一个字母。
Dim i%, temp$
& & PY = &&
& & For i = 1 To Len(TT)
& && && &temp = Asc(Mid$(TT, i, 1))
& && && &If temp & 255 Or temp & 0 Then& &'是汉字吗？
& && && && & PY = PY & pinyin(Mid$(TT, i, 1)) '转化为拼音首字母，
& && && &Else
& && && && & PY = PY & LCase(Mid$(TT, i, 1))&&'转化英文字母
& && && &End If
& & Next i
End Function
Function pinyin(myStr As String) As Variant '自定义函数，目的：把单个汉字变为拼音的第一个字母。
& & On Error Resume Next
& & myStr = StrConv(myStr, vbNarrow)
& & If Asc(myStr) & 0 Or Err.Number = 1004 Then pinyin = &&
& & pinyin = Application.WorksheetFunction.VLookup(myStr, [{&吖&,&A&;&八&,&B&;&嚓&,&C&;&咑&,&D&;&鵽&,&E&;&发&,&F&;&猤&,&G&;&铪&,&H&;&夻&,&J&;&咔&,&K&;&垃&,&L&;&嘸&,&M&;&旀&,&N&;&噢&,&O&;&妑&,&P&;&七&,&Q&;&囕&,&R&;&仨&,&S&;&他&,&T&;&屲&,&W&;&夕&,&X&;&丫&,&Y&;&帀&,&Z&}], 2)
End Function
复制代码
16:21 上传
点击文件名下载附件
6.88 KB, 下载次数: 109
阅读权限20
在线时间 小时
感谢楼上了，不过我有很多行，不知道出错不哈。谢谢
阅读权限20
在线时间 小时
弄不了 乱码
玩命加载中，请稍候
玩命加载中，请稍候
Powered by
本论坛言论纯属发表者个人意见，任何违反国家相关法律的言论，本站将协助国家相关部门追究发言者责任！ & & 本站特聘法律顾问：徐怀玉律师 李志群律师没有更多推荐了，
加入CSDN，享受更精准的内容推荐，与500万程序员共同成长！