Dzwebs.Net

撰写电脑技术杂文十余年

Excel如何提取汉字拼音的首字母

Admin | 2009-8-5 12:45:09 | 被阅次数 | 17903

温馨提示!

如果未能解决您的问题,请点击搜索;登陆可复制文章,点击登陆

  如何提取汉语拼音的首字?一般来说,有两种方法!

  ①函数法:利用vlookup,但有一定的局限性,效率也是问题。

  ②vba法:是最佳的选择,并且,仅使用几行Excel VBA代码就行,为什么这么说呢?因为Excel里利用Vlookup工作表函数和Evaluate方法可以快捷的计算出结果。

  通过如下例子可以看出Excel VBA独有的优势。代码如下

  Public Function MyPY(ByVal vText As Variant) As String
  Application.Volatile
  Dim strResult As String
  Dim lStart As Long
  On Error Resume Next

  For lStart = 1 To Len(vText)
  strResult = strResult & Application.Evaluate("VLookup(""" & Mid(vText, _
                                                                         lStart, 1) & _
                                                                         """,  {""吖"",""A"";""八"",""B"";""嚓"",""C"";""咑"",""D"";""鵽"",""E"";""发"",""F"";""猤"",""G"";& _
""铪"",""H"";""夻"",""J"";""咔"",""K"";""垃"",""L"";""嘸"",""M"";""旀"",""N"";""噢"",""O"";&_
""妑"",""P"";""七"",""Q"";""囕"",""R"";""仨"",""S"";""他"",""T"";""屲"",""W"";""夕"",""X"";& _"
"丫"",""Y"";""帀"",""Z""},2,1)")
     Next

  MyPY = strResult

  End Function

  上文自定义函数提取的是纯汉字,但“中华人民共和国123(辽宁)”要求返回“ZHRMGHG(LN)”

“中华人民共和国1-辽宁”返回“ZHRMGHG-LN”怎么办?

  关键点:

  ①排除A~Z a~z 0~9,就是所有字母和数字。

  ②判断是否为每个提取的字符是否汉字。一般判断为汉字可以利用ASC码值判断,这里我提供另一种方法。

  整体代码如下:

  Public Function SuperPY(ByVal vText As Variant) As String

  Application.Volatile
  Dim strResult As String
  Dim lStart As Long
  Dim sTemp As String
  On Error Resume Next

  For lStart = 1 To Len(vText)

  sTemp = VBA.StrConv(Mid(vText, lStart, 1), vbNarrow)
         If sTemp Like "[!A-Z !a-z !0-9]" Then   '排除什么可以在like表达式中修改
             If Len(sTemp) <> LenB(StrConv(sTemp, vbFromUnicode)) Then


                 strResult = strResult & Application.Evaluate("VLookup(""" & Mid(vText, _
                                                                                 lStart, 1) & _
                                                                                 """,{""吖"",""A"";""八"",""B"";""嚓"",""C"";""咑"",""D"";""鵽"",""E"";""发"",""F"";""猤"",""G"";& _
""铪"",""H"";""夻"",""J"";""咔"",""K"";""垃"",""L"";""嘸"",""M"";""旀"",""N"";""噢"",""O"";""妑"",& _
""P"";""七"",""Q"";""囕"",""R"";""仨"",""S"";""他"",""T"";""屲"",""W"";""夕"",""X"";""丫"",""Y"";""帀"",""Z""},2,1)")

             Else

                 strResult = strResult & Mid(vText, lStart, 1)
             End If
         End If
  Next

  SuperPY = strResult

  End Function


网站备案号:

网站备案号:滇ICP备11001339号-7

版权属性:

Copyright 2007-2021-forever Inc. all Rights Reserved.

联系方式:

Email:dzwebs@126.com QQ:83539231