汉字转拼音首字的函数及其灵活运用

alzeng

谢谢朽大的建议，我会加以改进的。

原帖由 zldccmx 于 2009-8-4 15:08 发表


存在双击三挖？为什么T要用34个汉字？

是26个汉字。
因为UV两个字母系中不存在汉字，所以W中的首字用了三次。

alzeng

原帖由 李子然 于 2009-8-4 14:45 发表
不错的应用，如果是多列都要实现这样的效果要怎么办呢？因为这样感觉更实用些，请指教

多列的应用，可以采用以下方式完成：
Select Case Target.Column
Case 1
……
Case 2
……

thtfzhaobo

为什么在vb中效率很低？？？？？

lhdcxz

一般来说。名字都是在一片区域里面比较集中存放的，能否考虑用Worksheet_SelectionChange(ByVal Target As Range) 事件激发？把结果直接连接到名字后面如：张三 ZS，由用户自己去处理是否分开？（抛砖引玉）

alzeng

原帖由 lhdcxz 于 2009-8-4 18:32 发表
一般来说。名字都是在一片区域里面比较集中存放的，能否考虑用Worksheet_SelectionChange(ByVal Target As Range) 事件激发？把结果直接连接到名字后面如：张三 ZS，由用户自己去处理是否分开？（抛砖引玉）

关于这些方面的运用，主要是看用户需求，无论你预先做成什么样子，也不可能是万能的。比方说，把拼音字母缀在姓名后面很容易实现，但可能接下来就有人会问：“怎样把名字和字母拆分开呢？”
所以我只能做一个功能模块，别人要怎样用，用到什么地方，会做哪些改动，都是自由的事，^_^

AIEO.CN

原帖由 thtfzhaobo 于 2009-8-4 17:54 发表
为什么在vb中效率很低？？？？？

测试了一下，效率不算低，在笔记本上10万个单字用时略多于1秒，不错了。理论上，楼主用穷举法比对，似乎不够精致，二分法效率应该更高。

然而奇怪的是，本以为Excel内置函数效率高，特将字符串转为数组，采用 Match 函数定位，没想到居然速度比楼主的穷举法还要慢将近一倍，还是拿“最”做的测试。天呐，这就是我曾经景仰，以为理应无敌的内置函数？！

[ 本帖最后由 AIEO.CN 于 2009-8-5 09:41 编辑 ]

zldccmx

不知道用一个字典记录2312个汉字，应用中直接要字典中取这些字的首字母哪个来得快！

alzeng

原帖由 zldccmx 于 2009-8-5 10:02 发表
不知道用一个字典记录2312个汉字，应用中直接要字典中取这些字的首字母哪个来得快！

我在3日下午，就是用这个方法的，这需要添加一个字码表，应用起来不够方便。而且，我想这个速度肯定不会已过这个代码：因为它取一个字母最多运算26次，而穷举2312个汉字理论上远不止这个次数。
当然，如果要取全拼，这应该是个可行的方法。

lhdcxz

看看大侠、专家们的讨论，真获益不少！

zldccmx

原帖由 alzeng 于 2009-8-5 10:17 发表

我在3日下午，就是用这个方法的，这需要添加一个字码表，应用起来不够方便。而且，我想这个速度肯定不会已过这个代码：因为它取一个字母最多运算26次，而穷举2312个汉字理论上远不止这个次数。
当然，如果要取全拼 ...

老朽特意做一个附件，用于字典法与穷举法比较
比较的基础：65535*5个汉字
Option Compare Text

      '撰写:alzeng
      '网址:http://Club.ExcelHome.net
      '日期:2009-8-5 下午 12:24:52
Function PY(ByVal Rng As Range )
    Dim K%, str$
    str = Replace(Replace(Rng, " ", ""), "　", "")
    For I = 1 To Len(str)
        K = 1
        Do Until Mid("芭嚓搭蛾发噶哈击击咔垃妈拿哦啪期然撒塌挖挖挖昔压匝咗", K, 1) > Mid(str, I, 1)
            K = K + 1
        Loop
        PY = PY & Chr(64 + K)
    Next
End Function


      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-8-5 下午 12:10:36
Public Function Zpy(Rng)
    Dim A&
    On Error Resume Next
    A = Dic.Count
    If A = 0 Or Err.Number <> 0 Then Call init: Err.Clear: On Error GoTo 0
    For I = 1 To Len(Rng)
        Zpy = Zpy & Dic(Mid(Rng, I, 1))
    Next
End Function


      '撰写:老朽
      '网址:http://Club.ExcelHome.net
      '日期:2009-8-5 下午 12:10:37
Sub init()
    Dim Txt
    Txt = Txt & "吖A阿A啊A锕A嗄G哎A哀A唉A埃A挨A欸A锿A捱A皑A癌A嗳A矮A蔼A霭A艾A爱A砹A隘A嗌A嫒A碍A叆A暧A瑷A僾A薆A餲A安A桉A氨A庵A谙A媕A腤A鹌A鞍A闇A鮟A盫A啽A垵A俺A唵A埯A铵A揞A晻A犴A岸A按A案A胺A暗A黯A肮A昂A枊A盎A醠A凹A坳A垇A爊A敖A嗷A嶅A廒A獒A遨A熬A璈A翱A聱A螯A謷A鳌A鏖A芺A拗A袄A媪A岙A傲A奡A奥A骜A墺A澳A懊A鏊A八B巴B叭B扒B朳B吧B夿B岜B芭B疤B捌B笆B粑B豝B鲃B拔B茇B胈B菝B跋B魃B鼥B把B钯B"
'''
''由于受长度限制，初始化代码只取了片段
'''
    Txt = Txt & "濯Z镯Z灂J仔Z孜Z兹C咨Z姿Z茲Z赀Z资Z淄Z缁Z谘Z孳Z嵫Z滋Z粢Z辎Z觜Z趑Z锱Z龇Z髭Z鲻Z籽Z子Z姊Z秭Z耔Z笫Z梓Z紫Z滓Z訾Z字Z自Z恣Z渍Z眦Z宗Z综Z棕Z腙Z踪Z鬃Z总Z偬Z纵Z粽Z邹Z驺Z诹Z郰Z陬Z鄹Z鲰Z走Z奏Z揍Z租Z菹Z足Z卒Z族Z傶Z镞Z诅Z阻Z组Z俎Z珇Z祖Z躜Z缵Z纂Z钻Z攥Z嘴Z最Z罪Z蕞Z醉Z尊Z遵Z樽Z鐏Z鳟Z僔Z撙Z昨Z左Z佐Z作Z坐Z阼Z怍Z柞Z祚Z胙Z唑Z座Z做Z"
    Set Dic = CreateObject("Scripting.Dictionary")
    For I = 1 To Len(Txt) - 1 Step 2
        Dic(Mid(Txt, I, 1)) = Mid(Txt, I + 1, 1)
    Next
End Sub