获得汉字字符串拼音首字母

作者：iwebsms的专栏

'返回给定字符串的首字母<!----><o:p></o:p>

Function IndexCode(ByVal IndexTxt As String) As String<o:p></o:p>

    Dim i As Integer<o:p></o:p>

    For i = 1 To IndexTxt.Length<o:p></o:p>

        IndexCode = IndexCode & GetOneIndex(Mid(IndexTxt, i, 1))<o:p></o:p>

    Next<o:p></o:p>

End Function<o:p></o:p>

 <o:p></o:p>

'得到单个字符的首字母<o:p></o:p>

Private Function GetOneIndex(ByVal OneIndexTxt As String) As String<o:p></o:p>

    If Asc(OneIndexTxt) >= 0 And Asc(OneIndexTxt) < 256 Then<o:p></o:p>

        GetOneIndex = OneIndexTxt<o:p></o:p>

    Else<o:p></o:p>

        GetOneIndex = GetX(CInt(Format((Asc(OneIndexTxt) + 65536) \ 256 - 160, "00") & Format((Asc(OneIndexTxt) + 65536) Mod 256 - 160, "00")))<o:p></o:p>

    End If<o:p></o:p>

End Function<o:p></o:p>

 <o:p></o:p>

'根据区位得到首字母<o:p></o:p>

Private Function GetX(ByVal GBCode As Integer) As String<o:p></o:p>

    '判断一级汉字<o:p></o:p>

    If GBCode >= 1601 And GBCode < 1637 Then GetX = "A"<o:p></o:p>

    If GBCode >= 1637 And GBCode < 1833 Then GetX = "B"<o:p></o:p>

    If GBCode >= 1833 And GBCode < 2078 Then GetX = "C"<o:p></o:p>

    If GBCode >= 2078 And GBCode < 2274 Then GetX = "D"<o:p></o:p>

    If GBCode >= 2274 And GBCode < 2302 Then GetX = "E"<o:p></o:p>

    If GBCode >= 2302 And GBCode < 2433 Then GetX = "F"<o:p></o:p>

    If GBCode >= 2433 And GBCode < 2594 Then GetX = "G"<o:p></o:p>

    If GBCode >= 2594 And GBCode < 2787 Then GetX = "H"<o:p></o:p>

    If GBCode >= 2787 And GBCode < 3106 Then GetX = "J"<o:p></o:p>

    If GBCode >= 3106 And GBCode < 3212 Then GetX = "K"<o:p></o:p>

    If GBCode >= 3212 And GBCode < 3472 Then GetX = "L"<o:p></o:p>

    If GBCode >= 3472 And GBCode < 3635 Then GetX = "M"<o:p></o:p>

    If GBCode >= 3635 And GBCode < 3722 Then GetX = "N"<o:p></o:p>

    If GBCode >= 3722 And GBCode < 3730 Then GetX = "O"<o:p></o:p>

    If GBCode >= 3730 And GBCode < 3858 Then GetX = "P"<o:p></o:p>

    If GBCode >= 3858 And GBCode < 4027 Then GetX = "Q"<o:p></o:p>

    If GBCode >= 4027 And GBCode < 4086 Then GetX = "R"<o:p></o:p>

    If GBCode >= 4086 And GBCode < 4390 Then GetX = "S"<o:p></o:p>

    If GBCode >= 4390 And GBCode < 4558 Then GetX = "T"<o:p></o:p>

    If GBCode >= 4558 And GBCode < 4684 Then GetX = "W"<o:p></o:p>

    If GBCode >= 4684 And GBCode < 4925 Then GetX = "X"<o:p></o:p>

    If GBCode >= 4925 And GBCode < 5249 Then GetX = "Y"<o:p></o:p>

    If GBCode >= 5249 And GBCode <= 5589 Then GetX = "Z"<o:p></o:p>

 <o:p></o:p>

    '判断二级汉字<o:p></o:p>

    If GBCode >= 5601 And GBCode <= 8794 Then<o:p></o:p>

        Dim CodeData As String<o:p></o:p>

        CodeData = "cjwgnspgcenegypbtwxzdxykygtpjnmjqmbsgzscyjsyyfpggbzgydywjkgaljswkbjqhyjwpdzlsgmrybywwccgznkydgttngjeyekzydcjnmcylqlypyqbqrpzslwbdgkjfyxjwcltbncxjjjjcxdtqsqzycdxxhgckbphffsspybgmxjbbyglbhlssmzmpjhsojnghdzcdklgjhsgqzhxqgkezzwymcscjnyetxadzpmdssmzjjqjyzcjjfwqjbdzbjgdnzcbwhgxhqkmwfbpbqdtjjzkqhylcgxfptyjyyzpsjlfchmqshgmmxsxjpkdcmbbqbefsjwhwwgckpylqbgldlcctnmaeddksjngkcsgxlhzaybdbtsdkdylhgymylcxpycjndqjwxqxfyyfjlejbzrwccqhqcsbzkymgplbmcrqcflnymyqmsqtrbcjthztqfrxchxmcjcjlxqgjmshzkbswxemdlckfsydsglycjjssjnqbjctyhbftdcyjdgwyghqfrxwckqkxebpdjpxjqsrmebwgjlbjslyysmdxlclqkxlhtjrjjmbjhxhwywcbhtrxxglhjhfbmgykldyxzpplggpmtcbbajjzyljtyanjgbjflqgdzyqcaxbkclecjsznslyzhlxlzcghbxzhznytdsbcjkdlzayffydlabbgqszkggldndnyskjshdlxxbcghxyggdjmmzngmmccgwzszxsjbznmlzdthcqydbdllscddnlkjyhjsycjlkohqasdhnhcsgaehdaashtcplcpqybsdmpjlpcjaqlcdhjjasprchngjnlhlyyqyhwzpnccgwwmzffjqqqqxxaclbhkdjxdgmmydjxzllsygxgkjrywzwyclzmcsjzldbndcfcxyhlschycjqppqagmnyxpfrkssbjlyxyjjglnscmhcwwmnzjjlhmhchsyppttxrycsxbyhcsmxjsxnbwgpxxtaybgajcxlypdccwqocwkccsbnhcpdyznbcyytyckskybsqkkytqqxfcwchcwkelcqbsqyjqcclmthsywhmktlkjlychwheqjhtjhppqpqscfymmcmgbmhglgsllysdllljpchmjhwljcyhzjxhdxjlhxrswlwzjcbxmhzqxsdzpmgfcsglsdymjshxpjxomyqknmyblrthbcftpmgyxlchlhlzylxgsssscclsldclepbhshxyyfhbmgdfycnjqwlqhjjcywjztejjdhfblqxtqkwhdchqxagtlxljxmsljhdzkzjecxjcjnmbbjcsfywkbjzghysdcpqyrsljpclpwxsdwejbjcbcnaytmgmbapclyqbclzxcbnmsggfnzjjbzsfqyndxhpcqkzczwalsbccjxpozgwkybsgxfcfcdkhjbstlqfsgdslqwzkxtmhsbgzhjcrglyjbpmljsxlcjqqhzmjczydjwbmjklddpmjegxyhylxhlqyqhkycwcjmyhxnatjhyccxzpcqlbzwwwtwbqcmlbmynjcccxbbsnzzljpljxyztzlgcldcklyrzzgqtgjhhgjljaxfgfjzslcfdqzlclgjdjcsnclljpjqdcclcjxmyzftsxgcgsbrzxjqqcczhgyjdjqqlzxjyldlbcyamcstylbdjbyregklzdzhldszchznwczcllwjqjjjkdgjcolbbzppglghtgzcygezmycnqcycyhbhgxkamtxyxnbskyzzgjzlqjdfcjxdygjqjjpmgwgjjjpkjsbgbmmcjssclpqpdxcdyykypcjddyygywchjrtgcnyqldkljczzgzccjgdyksgpzmdlcphnjafyzdjcnmwescsglbtzcgmsdllyxqsxsbljsbbsgghfjlwpmzjnlyywdqshzxtyywhmcyhywdbxbtlmswyyfsbjcbdxxlhjhfpsxzqhfzmqcztqcxzxrdkdjhnnyzqqfnqdmmgnydxmjgdhcdycbffallztdltfkmxqzdngeqdbdczjdxbzgsqqddjcmbkxffxmkdmcsychzcmljdjynhprsjmkmpcklgdbqtfzswtfgglyplljzhgjjgypzltcsmcnbtjbhfkdhbyzgkpbbymtdlsxsbnpdkleycjnycdykzddhqgsdzsctarlltkzlgecllkjljjaqnbdggghfjtzqjsecshalqfmmgjnlyjbbtmlycxdcjpldlpcqdhsycbzsckbzmsljflhrbjsnbrgjhxpdgdjybzgdlgcsezgxlblgyxtwmabchecmwyjyzlljjshlgndjlslygkdzpzxjyyzlpcxszfgwyydlyhcljscmbjhblyjlycblydpdqysxktbytdkdxjypcnrjmfdjgklccjbctbjddbblblcdqrppxjcglzcshltoljnmdddlngkaqakgjgyhheznmshrphqqjchgmfprxcjgdychghlyrzqlcngjnzsqdkqjymszswlcfqjqxgbggxmdjwlmcrnfkkfsyyljbmqammmycctbshcptxxzzsmphfshmclmldjfyqxsdyjdjjzzhqpdszglssjbckbxyqzjsgpsxjzqznqtbdkwxjkhhgflbcsmdldgdzdblzkycqnncsybzbfglzzxswmsccmqnjqsbdqsjtxxmbldxcclzshzcxrqjgjylxzfjphymzqqydfqjjlcznzjcdgzygcdxmzysctlkphtxhtlbjxjlxscdqccbbqjfqzfsltjbtkqbsxjjljchczdbzjdczjccprnlqcgpfczlclcxzdmxmphgsgzgszzqjxlwtjpfsyaslcjbtckwcwmytcsjjljcqlwzmalbxyfbpnlschtgjwejjxxglljstgshjqlzfkcgnndszfdeqfhbsaqdgylbxmmygszldydjmjjrgbjgkgdhgkblgkbdmbylxwcxyttybkmrjjzxqjbhlmhmjjzmqasldcyxyqdlqcafywyxqhz"<o:p></o:p>

        GetX = Mid(CodeData, (Microsoft.VisualBasic.Left(CStr(GBCode), 2) - 56) * 94 + (Microsoft.VisualBasic.Right(CStr(GBCode), 2)), 1)<o:p></o:p>

    End If<o:p></o:p>

End Function