|
|
列举出所有的汉字,在一个一个匹配。方法有的笨,但是可以适合所有汉字。有些偏的汉字,大家可以自己加进去。
Option Explicit
'功能:取汉字拼音首字母函数
'参数:as_data 要提取的汉字
'返回:汉字拼音首字母
Sub test()
MsgBox f_get_py("张元光宏通VBA软件工作室") '字、词、句
End Sub
Sub test1()
MsgBox f_get_py("Y") '字母数字测试
End Sub
Sub test2()
MsgBox hz2py("张") '一个字
End Sub
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 & "比笔闭鼻碧必避逼毕臂彼鄙壁蓖币弊辟蔽毙庇敝陛毖痹秘泌秕薜荸芘萆匕裨畀俾嬖狴筚箅篦舭荜襞庳铋跸吡愎贲滗濞璧哔髀弼妣婢仳佛卑埤复媲幅庀拂捭服枇檗殍波瞥纰脾虑被费跛鐾陂陴馥佊佖偪匂咇啚嗶坒堛夶奰妼娝嬶屄崥幣幤廦弻彃怭怶悂愊斃旇朼枈柀柲梐椑楅毴沘湢滭潷煏熚獘獙珌畁畐畢疕疪痺皀皕禆稫笓筆箃箄箆篳粃粊紕紴綼縪繴罷罼翍聛肶肸胇腗腷苾萞蓽蘗蜌螕袐襅襣觱詖诐豍貏貱費賁贔赑踾蹕躃躄邲鄨鄪鈚鉍錍鎞鏎鐴閇閈閉閟闬鞁鞞鞸韠飶饆馝駜驆髲魓魮鮅鮩鰏鲾鴓鵖鶝鷝鷩鸊鼊"
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 = ""
……
取汉字拼音首字母函数.rar
(52.57 KB, 下载次数: 779)
|
评分
-
2
查看全部评分
-
|
沪公网安备 31011702000001号 沪ICP备11019229号-2
发表于 2012-8-15 11:39
楼主
