[原创]汉字笔画函数

thanks

我想去掉括号有简便方法吗?

青阳

现在的算命软件都是用繁体字的,如果想应用在算姓名字数上,简体字不适用,版主能做个繁体的笔画库吗?

xuanhou

楼主辛苦了，收藏，谢谢了！

fanxp

发个诺贝尔奖给您

ZHENSIQIU

'请指教

'不带笔画库，使用排序对比求出

'可算20000余个汉字的笔画 Function STROCK(CHNCHR As String)

STR1 = "与之及夨扌3,尣乏以夃巨4,卍歺伋印囘夗5,仮似吸攰6,尦巫镸飏7,乸尩羋受烎鼡8,巻拏叟埩婙9,弬彧袅欫镹琤訚10,彪兞將晘梡祡営惸掽描毮逽镺匓碀11," STR2 = "晩鹀黃僆嗒搑斞斱殾溬溾遚镻飱黽廐12,媐戡琞缙臦勨厯奧摑槩滫潃舝蔜蜀澕諍踭13,慪歌熓獒僶儁墟夀嶑憈撗敻暮暱毃氁獡裦鄳镌閰養錚14," STR3 = "嬋摾曄槪誾憴懊擑澠澫濈濍縙諩錓镼餝15,碛膐輤錻阛韰厳殩濭篹襃餴鴱黿龜鵖16,燛簔闀謰譁鎹鎾饂黝鼀鵧兤賸17,藔羀臩薺鯐鵐齋夓瀢繩繱蠅譃鏅鏎鞳顝鯗鹱鼃18," STR3 = "儱隴馦齁匶幱譝譢鐅镽騪魓鯺鰙鼅鼅19,嚺蘤嚨壟寵巃徿攏瀧璺舋蘢騰鹹櫹櫹疉疉竈竈鐽鐽饏饏騿騿鬕鬕驆驆贏20,曨櫳爖瓏闢闦鷌龡龡讁讁镾镾鷝鷝鷨龝21,矓矓礱礱竉竉龢讉鱋鷬鷵鼆22," STR4 = "爢爢巔巔櫷櫷籠籠聾聾蠪蠪襲襲讎讎鬛鬛麟麟蠲鱦鱪鼈驘23,爤爤虁虁讋贚鹼纛讙鱰鸌鼉24,鑨鬬鸂鑶鱱鼊25,鬭虌讝鬮26,驡龞27,鱹28,龖36,齉37,靐39,龘51" STR1234 = STR1 + STR2 + STR3 + STR4 On Error Resume Next N = WorksheetFunction.Find(CHNCHR, STR1234) If N > 0 Then CN = "0" For i = N To Len(STR1234) CHAR0 = Mid(STR1234, i, 1) If CHAR0 <> "," Then If Asc(CHAR0) <= 57 And Asc(CHAR0) > 47 Then CN = CVar(CN) * 10 + CVar(CHAR0) End If Else STROCK = CInt(CN) Exit Function End If Next i Else Workbooks.Add tembook = ActiveWorkbook.Name STR0 = "一丁万不且丞丣並临丵乾亁亂僊僵亸償儭龎龏龑龒龓儾囔圞灥囖纞厵灩灪爩龗齾" For i = 1 To 35 Workbooks(tembook).Sheets(1).Range("A" + Trim(i + 1)).Value = i Workbooks(tembook).Sheets(1).Range("B" + Trim(i + 1)).Value = Mid(STR0, i, 1) Next i Workbooks(tembook).Sheets(1).Range("B" + Trim(i + 1)).Value = CHNCHR Workbooks(tembook).Sheets(1).Range("A2:b37").Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _ SortMethod:=xlStroke, DataOption1:=xlSortNormal STROCK = (Workbooks(tembook).Sheets(1).Range("A2").End(xlDown).Value) End If Application.DisplayAlerts = False Workbooks(tembook).Close Application.DisplayAlerts = True End Function

ZHENSIQIU

有一种直接调用汉字码元的点阵作矢量分析求笔画的算法，很多年前就听说过。

微软按笔画排序有部分乱序现象，表现在：

STR1 = "与之及夨扌3,尣乏以夃巨4,卍歺伋印囘夗5,仮似吸攰6,尦巫镸飏7,乸尩羋受烎鼡8,巻拏叟埩婙9,弬彧袅欫镹琤訚10,彪兞將晘梡祡営惸掽描毮逽镺匓碀11," STR2 = "晩鹀黃僆嗒搑斞斱殾溬溾遚镻飱黽廐12,媐戡琞缙臦勨厯奧摑槩滫潃舝蔜蜀澕諍踭13,慪歌熓獒僶儁墟夀嶑憈撗敻暮暱毃氁獡裦鄳镌閰養錚14," STR3 = "嬋摾曄槪誾憴懊擑澠澫濈濍縙諩錓镼餝15,碛膐輤錻阛韰厳殩濭篹襃餴鴱黿龜鵖16,燛簔闀謰譁鎹鎾饂黝鼀鵧兤賸17,藔羀臩薺鯐鵐齋夓瀢繩繱蠅譃鏅鏎鞳顝鯗鹱鼃18," STR3 = "儱隴馦齁匶幱譝譢鐅镽騪魓鯺鰙鼅鼅19,嚺蘤嚨壟寵巃徿攏瀧璺舋蘢騰鹹櫹櫹疉疉竈竈鐽鐽饏饏騿騿鬕鬕驆驆贏20,曨櫳爖瓏闢闦鷌龡龡讁讁镾镾鷝鷝鷨龝21,矓矓礱礱竉竉龢讉鱋鷬鷵鼆22," STR4 = "爢爢巔巔櫷櫷籠籠聾聾蠪蠪襲襲讎讎鬛鬛麟麟蠲鱦鱪鼈驘23,爤爤虁虁讋贚鹼纛讙鱰鸌鼉24,鑨鬬鸂鑶鱱鼊25,鬭虌讝鬮26,驡龞27,鱹28,龖36,齉37,靐39,龘51"

这部分字符，大家可以试试，也许是微软的BUG吧。这就是我为什么将它们先提出来做对比测验的原因。

tsiliang

有创意

zz5151353

加花鼓勵[em17][em23][em24]

engineerlz

佩服啊佩服！

qqboy1

拜读中............