取汉字拼音首字符的Function.docVIP

Option Explicit 功能:取汉字拼音首字母函数 参数:as_data 要提取的汉字 返回:汉字拼音首字母 时间:2006年05月29日 设计:李成章 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 Next 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 比笔闭鼻碧必避逼毕臂彼鄙壁蓖币弊辟蔽毙庇敝陛毖痹秘泌秕薜荸芘萆匕裨畀俾嬖狴筚箅篦舭荜襞庳铋跸吡愎贲滗濞璧哔髀弼妣婢仳佛卑埤复媲幅庀拂捭服枇檗殍波瞥纰脾虑被费跛鐾陂陴馥佊佖偪匂咇啚嗶坒堛夶奰妼娝嬶屄崥幣幤廦弻彃怭怶悂愊斃旇朼枈柀柲梐椑楅毴沘湢