ExcelTip.Net留存知识帖 ---【注：附件之前被网盘供应商清空后，现已修复-现已修复-现已修复为本地下载！】
现在位置：首页 > E问E答 > Excel VBA > 如何用vba代码对图书列表依指定排序标准进行排序？

如何用vba代码对图书列表依指定排序标准进行排序？

作者：绿色风 分类： 时间：2022-08-17 浏览：95
楼主
kevinchengcw		 Q: 如何用vba代码对图书列表依指定排序标准进行排序？
A: 排序规则如下：
一、分类号的比较是逐字符的；
二、分类号字符的优先顺序是：
a   NULL   /   -   (   ) “ ” =   <   >   :   +   0   1   2   3   4   5   6   7   8   9   A   B   C   D  E   F   G   H   I   J  K   L   M   N   O   P   Q   R   S   T   U   V   W   X   Y   Z   .
三、当分类号相同时，根据书名笔画数进行排序，符号于排序时优先于汉字

实现代码如下：
  1. Sub 规则排序()
  2. Dim Rule, Arr, Arrt, Arr2, Result, Dic As Object, Dic2 As Object, N&, I&, T&, R&, L&, A&, B&, Str$
  3. Rule = Split("a,,/,-,(,),“, ”,=,<,>,:,+,0,1,2,3,4,5,6,7,8,9,A,B,C,D,E,F,G,H,I,J,K,L,M,N,O,P,Q,R,S,T,U,V,W,X,Y,Z,.", ",")    '建立排序规则数组
  4. Set Dic = CreateObject("scripting.dictionary")  '建立字典对象
  5. Set Dic2 = CreateObject("scripting.dictionary")
  6. For N = Asc("A") To Asc("Z")  '循环生成分类号前两位字母列表去重后存入字典1中
  7.     For I = LBound(Rule) To UBound(Rule)
  8.         Str = Chr(N) & Rule(I)
  9.         If Not Dic.exists(Str) Then Dic(Str) = ""
  10.     Next I
  11. Next N
  12. With Dic2  '将排序顺序字符依次存入字典2中,item项用于储存对应的序号
  13.     .Add "a", 0
  14.     .Add "", 1
  15.     For N = LBound(Rule) + 2 To UBound(Rule)
  16.         .Add Rule(N), N + 2
  17.     Next N
  18. End With
  19. '下面生成字符笔画字符串,将汉字依笔画分组存入字符串变量中,用于后期生成笔画对应关系
  20. Str = Str & ",《》,一乙丶丨丿,"
  21. Str = Str & "人了力十入二厂又几九八儿七丁乃刀卜刁匕亻乜匚廴冖刂阝冫冂凵亠讠勹卩厶,"
  22. Str = Str & "大工上个于下万也与之三小已子门及口广义山干亿乡才己么女马土士千卫习飞久" & _
  23.             "川亏凡亡夕丈寸巾叉丸尸刃乞弓勺兀幺弋丫孑氵囗巳亍乇孓扌饣艹纟犭彳辶廾宀忄尢夂屮" & _
  24.             "巛丌彐彡丬,"
  25. Str = Str & "中不为以日公开方长月化分区元文从天水内心今计办比车无书队专少手认五风见支引反王" & _
  26.             "仅气户历艺双切巴友火六太什片毛仍止予夫升介斗云丰巨互木午邓订币厅斤瓦尤牛父乌仁" & _
  27.             "井丹扎乏牙贝欠凤允孔仓氏忆戈匹劝尺韦歹幻凶冈丑尹犬勾屯仆厄仑曰仇匀勿兮亢毋夭仃" & _
  28.             "爪丐冗讥卞廿仉卅爿讣壬亓仄刈闩爻攵殳攴礻灬仂肀,"
  29. Str = Str & "业发市出生民对他们主用本加外务电可司平代目立北术由记去正东议世处四台只头必包打" & _
  30.             "它节布占功讯史示石央失尔未让乐边白号且半古令龙汇田写兰训宁印犯击另讨汉申卡召永" & _
  31.             "尼左右刊玉付乎旧皮叶母仪归礼叫册末丝辽矛甘句冬旦纠邦卢灭甲幼圣奶艾瓜巧冯厉鸟兄" & _
  32.             "叹闪仙丛弘仔扑匆丘弗孕帅仗轧卉汁斥丙甩饥穴扔奴仕叮玄乍驭扒凹尬叭矢冉禾凸叩汀囚" & _
  33.             "札夯叨皿叱匝卯叽丕戊邝阡尕钅叻邗仨讫讪刍仫仡仞叼仝邛邙讦叵讧尻卟弁氐仟犰尥劢疋" & _
  34.             "衤卮忉宄艽艿疒庀戋氕阢,"
  35. Str = Str & "在有年会地产行成多全场企同动合关机自设后过农而各好当问次名向达收并如西华任导决" & _
  36.             "交安此先价因**件团级权江式老优至观创论协那划争百回众州亚色列兴许则光再她师负" & _
  37.             "约纪份米存防考访字刘红买充阳执尽讲扩早岁阶吃网托欢刚庆压吸死扬妇圳伟血冲迅伍吉" & _
  38.             "杂伤曲危孙齐似守毕朱污衣异伊庄休寻肉轨戏夺壮冰刑劣伙乔阵伐闭吗羊灯扣迈忙伪迁杀" & _
  39.             "伦妈宅竹仲亦虫池扫耳仿旨吁阴纤汗旬朴巩宇闯巡臣羽灰兆尖伏廷吕寺尘汤页爷吊舟吐驰" & _
  40.             "芝讼汛丢仰乒妆圭圾迄帆夹牟汕邢夸朵乓旭芒汝岂匈肌邪匠伞吓朽尧舌厌夷奸贞扛讳阮诀" & _
  41.             "屿讶汲纫祁讽妄戎戍圩屹匡亥讴夙驯妃阪讷吆弛犷亘芋戌邬吏汐迂驮肋曳旮旯伫邡闫岌丞" & _
  42.             "佤伎圪臼阱讹忖忏聿伉芍伢扪汊艮舛纣玑芗凼耒屺芨囡扦纨凫氖圹芊伧仵芎氘钇伥厍犸汔" & _
  43.             "吒钆氽刎夼讵吖缶圮玎牝妁乩囟纥囝饧圬伛犴冱纩糸仳芑芄圯纡汆芏虍汜刖,"
  44. Str = Str & "这作来我进时报体社员利改技位还应里两系条际投间步把但村求运县局形近更没志证别批" & _
  45.             "究张每传快李完走极身严况告识劳护花克医何财连抓住坚均足即评你层低远初助余困声却" & _
  46.             "材陈希良围苏吨言汽努状兵补纳阿听沙私针园判陆找亩迎疗纷宏诉秀序库违否角灾杨免吴" & _
  47.             "岛束饭彻励纸男抗贡扶乱邮块延怀纺灵含冷泛岗攻启丽估饮纯抢坐沈附词坏折沉床忘宋鸡" & _
  48.             "麦返穷辛帐伴劲谷沟忧弟呈佛伯杜芳阻弃拒坛纽吧寿纵旱迟邻豆扭诊址扰伸冶纲拟闲邹役" & _
  49.             "肖弄君兑赤汪抑牢驱妥岚尾坝犹芬妙译肝抚冻劫忍吹杆戒串坑狂沪玛坊孝辰吞汰抛纱苍灿" & _
  50.             "邱呀尿沃肠甸诈沧罕呆牡吾壳坎纹沛孜沂邵妨佐杏扮杠盯灶抄肚芦岐甫杉忌芜轩庐闷驳芽" & _
  51.             "纶钉扯纬抒芯邯亨吟佣抖坟芭邑佑韧沥汾陇卵坠吵矶芹孚钊歼吻沁皂汹灼旷呕忱沦忡龟沐" & _
  52.             "苇巫矣扼庇陀彤呐刨抉扳杖删坞秃芸忻饪灸驴闵岑囤芙屁坂肘伶苎纭岔吼呜杞伺抠甬佟卤" & _
  53.             "芮芷姊祀狄妍邸汞邳沅囱妖圻佘妓匣汶岖吭坍呛沌吱伽汴芥吝怅汩羌酉闰攸芪陂玖妩妒町"
  54. Str = Str & "吩彷妊抡吮肛忐忑怆佚狈吠诏呗饨岙诃苋诒岜沏汨陉诋妪杈鸠苄佗佃诅妞沤佝呋虬沔吡囵" & _
  55.             "劭囫纾沣纰邰诂忒芾沆奂岘疖忾肓轫炀闳苣忪呓饬妤忸邺诌苌伲邴坜佞芩抟芫欤呃芡芴钌" & _
  56.             "旰妫怄豕帏闱豸苁呔佥肟妣疔妗芘诎劬庑氙杓氚苊呒呖沩苡吲卣佧怃庋芤奁杩芟迓孛芈钋" & _
  57.             "姒忤饫阼坌呙苈吣肜迕杌饩邶忭阽芰刭闶泐狃岍兕岈狁忮,"
  58. Str = Str & "的国和经到建实学制法现定者事金其所委使明规些表京性组放物治取府质育果服单受织变" & _
  59.             "林转构具或势易视参该责备供知环话采青拉直股河线非货始限房周命依范油空往注英承版" & _
  60.             "购届例担居图试武卖审店念罗矿终底泽波降苦欧征态画宝贫招官绍录练奋贯拥细奇拍固券" & _
  61.             "刻沿述艰呼尚季松典夜轮板岸味呢择鱼驻坦雨败拓析宗肥宜抵佳昌若诗郑泥坡杰享牧卷径" & _
  62.             "忠迫软询朋诚肃怕肯奔杯奉抽剂废饰顶码旺侨凭拨幸姓拔畅舍陕拖盲净妻欣玩迪苗昆杭忽" & _
  63.             "姐胀虎贩炉郊炎玻诞泳枪拆泪饱刷驶抱佩押怪枚孟岩岭侧鸣饲闹刺柜姑贪驾氛郎姆贤茂孤" & _
  64.             "卓轰妹肩枝爸狗胁丧详函泊乳岳抬炒歧凯茅衫昂彼浅昔侦泡顷庞弥肿苹庙耶披屈帕姻郁肤" & _
  65.             "拚爬厕垃垄衬阜奈垂帜枣叔钓卧枢刮拘泼昏肺亟泄坪拦坤闸齿陋沸秉刹咖炬兔拐贬沫贮陌" & _
  66.             "苑隶宠肢妮抹枫庚侃沾肾迭佼宛弦拢宙呵侠觅怡坯坷帘驼绎斧怖咏泣殴炊咋怜苟肴枕泻苯" & _
  67.             "斩沼茄拣沓肪岱玫卑拂迢泌氓泓狐泗苛侣炜拌秆咐枉驹咄迩账炕沽禺拇泾弧炙祈卒泸拙帖" & _
  68.             "侍诣侄绅拎昊卦疚咕咀拧疡侗侈苓呱沱茁泱绊侥疙茎迥奄疟沭昕乖佰拄玮怯咚佬泞姗驿诧" & _
  69.             "苔茉诙抨迦咎诠竺冽矸诡矾呻兖孢泯瓯炖虏屉咒侬沮驷杼宕哎弩穹苞甙坳牦泠岫岷咔怦瓮" & _
  70.             "冼肮钎於杷拗茏怵钒枇帚郅臾杳矽咆帛罔绉忿坻侏坨盂诘诩迤劾昙咙砀峁拈虱咛肽怔饯宓" & _
  71.             "绌苒枭怂佯祉垅炔杲苷怿甾盱绂咂苕饴峄妾诛钗囹苜坭岿狞枥诤呷鸢庖郓狍苫茔衩茌怏钕" & _
  72.             "抿剁泅疝抻杵枋刽呤绀侩帙郇戕迳咝枞呦岢肱妯钏泔狙佻绐岬戾茕泮郄泫隹诟诨郐钍狒佶" & _
  73.             "疠驸叁钐忝侪坼玢绋岣肼黾怩驽昀坩殁郏侉茆狎苴帔苤肫怙呸苘朊帑怍迨轭诖炅戽枧剀诓" & _
  74.             "戗怛籴泷泺泖炝妲沲苻拊刿虮刳玟呶枘佾茚邾畀坫怫陔杪茑诜驵驺怊徂岽佴匦岵卺诔侔肭" & _
  75.             "肷骀穸绁侑昃茇枨耵弪垆钔苠坶孥祆迮,"
  76. Str = Str & "是要政济品重前面说种总省度保科将美点革活统南结项院界持城相研信标费施看战很给指" & _
  77.             "查举型首思贸选带神律类按养食客闻复段须便奖响药突香宣促显春适除修亲挥荣洲险待星" & _
  78.             "轻钢独送某派室临差树庭胜贷音既测洋括绝故草贵顺孩津退帮虽觉急语俄威追映甚洪怎哈" & _
  79.             "祖罚染胡封残骨赵钟毒哪挂架秋厚盾茶冠勇背迹览误亮冒峡珍穿祝络贴荒侵挑洗恢赴洁洛" & _
  80.             "胆贺绕屋盈勃炼宫柱洞胞宪炭俊皇咨俗绘迷挖昨浓炮柬帝炸拜栏柳耐疫挤恰牵尝奏秒荡姜" & _
  81.             "钦逃剑狠绒洽侯阁诱恒挺牲烂屏砖脉柏削荐拼挪洒虹叙垦胎玲盼盆钩姿姚挣皆娃亭怨咱昭" & _
  82.             "兹契柔栋窃眉娜俏巷轴幽厘逆卸俩骄饼俭彦砂勋钞狱茫咸茨蚀狮弯胃炳奎浑柯鬼挡虾闽畏" & _
  83.             "垫砍垒衍哀咬怒浇哄狭勉饶恨泵荆枯逊拾禹俞骂郝钧歪籽恼昼俑荫徊氟咽挠茧哑钥蚁珊胖" & _
  84.             "挝绑骆疯垮阀荟荧荔毗钙缸竖洼矩诫柑烁氢虐酋陡哗拱柿娇姨绚徇昧砌诵鸦恤茬钮蚂拯茵" & _
  85.             "骅绞浊叛恪砚竿贻浏俘炯扁侮哉耍疮峙娄钠茹炽贱祠娅怠陨饺诲诬胚哇垣胧郡垢栉挟祛闺" & _
  86.             "恍峦笃柄奕帧趴咳姥哟拮柚鸥毡茜迸栈饵拴栅拷钛茸珑殃钨狩洱甭俨恺疤剌弈轶炫拭陛胫" & _
  87.             "珀囿殆狡恬柠胥洙珂袂屎咫俐垛浒郧宦拽眨峥钝枸姣骇恃茗绛袄挎垠剃荃咤烃咪荤荪徉昶" & _
  88.             "昱韭荞柘祚秭柞荀钚茯浔珏咯玷贲荥涎籼胄瓴莒庥阂骁俟哆浃癸柩钡盹赳飒姹荠昵洵砭孪" & _
  89.             "挞哒枷闾垩矜郗蚤荏俎枰俪竽朐盅眈垭茭峋恽珉哌娆恸饷郜訇咧逄洮栎畈轱郢轲郦祜叟罘" & _
  90.             "荚俚陟恻牯钜匍耷舢峒茴峤诰昝狰逅洹姝氡钤垧笈钣恫觇酊垡珈茱皈胤鸩洌荦砘轳疣钯咣" & _
  91.             "庠贰恂咿枳砒姘衽俣炷毖荩哐垴殇珐胛骈柁咦羿轸玳疥弭柒柽剐贶哔洄浍垲恹爰胝钭绔哝" & _
  92.             "荨荑栀斫鸨俦虻诮绗垌曷祗茺柢砜垓钪哂炻哓宥秕荜窆虺牮诳栌哞柰狲殄洧咻洫洇胗飑砗" & _
  93.             "胍顸衲呲殂洚泶钫咭疬荬畋轵怼哏钬茳柃胪俜洳埏茈哚荭後衿狯昴祢眄咩荛彖枵轺虿胨郛" & _
  94.             "茛咴洎挢扃哙娈栊眇陧俅闼炱莛荇舣浈窀舡垤祓尜虼烀轷哕哜胩眍轹畎狨矧胂贳茼柝诶柙" & _
  95.             "砉砑舁拶荮耔胙,"
  96. Str = Str & "家部展资高能起海通都特调党原造效格益样被流难准积消值真谈料案较根速验获席热息校" & _
  97.             "配钱础破铁病致爱容称素请健竞继紧旅监预站班离核逐座损换顾套留航剧烈害缺酒读索桥" & _
  98.             "候拿笔般脑债烟倍顿振夏借兼谁徐课途润租档秘宾倒涉泰疾珠虑射宽涨浙晓载笑哥赶殊峰" & _
  99.             "倾乘透莫浪弱唐耕泉恩盐捐郭颁诸祥恶秩涌陶诺圆畜烧秦粉桂胶耗谊浦倡症埃莱陵轿递娘" & _
  100.             "徒涛朗桑娱钻浩晋捕浮恐旁陪瓶陷柴俱贾荷哲敌啊凌阅瓷衰悄袁桌拳贿涂栽赁峻衷唤逝宴" & _
  101.             "舰桃凉艳框埔氧株胸莲逢脏埋鸭哭铃烦疲牺顽卿悟罢恋翁脂袖悦捞剥脆宰殷扇浆挽烤莉疼" & _
  102.             "蚕绣聂浴涝辱颂桐赂涤挫畔莎捉倪铅恳浸脊氨挨舱桩眠匪窄秧壶谅哨砸悔桔臭翅赃笋剖莞" & _
  103.             "饿挚捆斋耿栗俺耘晒狼逛耸娟晃绥栖晖倦倘恭烫钾宵秤剔冤哺耻郸峪晕羞莹朔袜烘骏耽峨" & _
  104.             "涩捏娣躬豹俯蚊皱姬唇盎浚栓捡匿贼涟窍逗铎陲哩蚌悖烛屑捣桦狸栩桢烨莆酌涡唁爹胺盏" & _
  105.             "荻捍紊绢娥凄胳袍桓莽倩骋峭冥圃钰隽恕殉毙涅倚徕胰谆珲娴涣烙祯捎桨郴莘逞晏钳娓偌" & _
  106.             "釜虔莺诿鸵铀荼玺哦莓悍哮涓敖倔诽脐捅奚皋砺哼涧袒捂馁逍恙垸脓钴骊袅埂唉梆栾哽娩" & _
  107.             "涕鸳珩眩脍崂鸯铂砾凋晔唠疹勐舫铆笆恣砥亳耙娠冢砷羔耄钼唑莅唆胱唢钵烬莠浜轼倜祟" & _
  108.             "桅邕晌晟蚜悯铄铉宸氦桎胭娑痉晁挛倏俳砼涞耆赅珞砝粑倌砻婀舀俸砰唏悌饽烩秣疽悚奘" & _
  109.             "蚝砣砧郯倭阆圄罡觊蚬窈眙痂蚧涔酐鸪蚓埕疱趸疸桁唛娲哧蚣钹浣剜氤俾铋桧倥捋浯厝疴" & _
  110.             "隼埙桉蚪逖唔珙铌钺氩胯浠桠倬唧桀挈豺琊钿逦凇涠烊谀屐颀绦栲孬挹胴娌娉谇笕崃馀豇" & _
  111.             "莨臬舐莴莪鸬铍趵荸砬痈笏阄胼舨钽逡莸倨郫旃蚩蚨罟埚笄旆恁莳趿钲贽砩猁悭衾眚铈莜" & _
  112.             "逋谄莼衮秫涑铊捌屙鬲袢蚋绡赀畚疳蚍逑剡狺诹恚桕埒脒绨顼悒珥绠颃赆旄桡狻砟朕诼笫" & _
  113.             "龀狷悃莶畛轾耖鸫盍栝浼埘鸶梃痃笊舯陬狴髟鸱帱瓞莩剞恝悝辂敉衄钷桤悛辁谂荽猃狳痄" & _
  114.             "酎砹舭钸鬯哿桄胲桊捃莰钶阃栳倮毪恧陴鸲脎祧軎珧酏眢唣哳疰浞,"
  115. Str = Str & "理得第商着基教领营情据深职常接做推副率清族续望售象银检断黄维培随球控排措域康减" & _
  116.             "章票菜眼著略综密馆假晚授探船彩绩够停移救绿脱累偿盛堂辆械竟跃符唱患雪渠野萨梅盖" & _
  117.             "距惊盘梁渐敢脚勒悉婚掉混谋唯隆猪谓敏麻梦偏渔弹毫您蛋猛液虚曼淡圈颇崇铜曹盗晨脸" & _
  118.             "寄欲添袋捷旋隐偷勘淮辅惜宿粗菲掘袭堆涵绪绸梯描硕铝崛斜啤廊舶菌甜鸿衔悠萍偶悬剪" & _
  119.             "焕堵晤婆鹿萄盒萧骑铭淘淑窑菊绵阐惨崭渗崔婴笼粒淀蛇猎袱桶掀彬绳啥焊猫淫龚颈捧涯" & _
  120.             "掏掩粘啦谐烯逻屠寂聊爽祸乾淹阎庸兽鄂梨啡淋戚厢菇帷凰淄菱彪凑渊逸萃崖萎痕硅巢埠" & _
  121.             "逮萌掺雀悼谜徘匙酝祭猜梧眷惕梭尉秽婉鸽聋淤睁惧萝烹兜猖崩彗铮寅琅淳掠躯匾矫娼犁" & _
  122.             "奢梳啸惟缀淌啃琐脖眶笛铲匮梓帼崎掷秸绮寇隋冕娶谎梗颅赈硒菏烽渎铵绽绰笨眺舸痒敛" & _
  123.             "孰萦涪舷眸焉辄堕惦谍羚菩谙庵淇琉菠铨翌馅痊聆渍粕隅淆谛梢笙绷惋掂涿袤涮庶掖眯赦" & _
  124.             "啪赊菁猕祷脯舵铢烷酚铬啧铐谚窒盔惭鸾蛀涸徙渚琏豚悸铣淅掬铤梵偕猝猗捺婪翎徜掐皑" & _
  125.             "淦堑惬偃酗笺衅趾淞疵隍逵婶惘痔惮晦铱捶皎谒淖扈旎焘悻捻笠啬萤唬旌悴绶敝蛎梏铧谏" & _
  126.             "畦惚惆馄铛谌淙淬偎渑埭崮馗翊恿萸啄偻谑戛萋逶痍掮羟骐鄄跄窕谕啕绯捱焖龛萘麸蛊厩" & _
  127.             "蚯唰裆绫埝匐铠蚶捭晗蛆婵赉偬菖婕掳铡崆菽笳菅啮揶掇隗殒豉敕掸淝铰庹啜啶棂崧殓逯" & _
  128.             "蚱匏斛婧绺渌啭婊铒菡喏舂谔蛉笤堇傀阉庾阊笞硐硌啉眭蚴蛏桷掊铯硖啖唳淠郾婢啐菪焐" & _
  129.             "啁缍脲殍砦铖悱偈堀挲崦掼铙绻菘阋菰袈啷桴赧埤铩猞绾铟阏谝筇铷笥铕阈谗聃铪裉笸桫" & _
  130.             "脘眦埯铳菔粝萁酞菟谖雩骓缁笪唿袷铑捩悫绱粜菀牾笮舴鸷啵晡鸹涫铗皲萜堍崤痖菸唷圉" & _
  131.             "庳笾铥趺笱掴猓蚵萑掎渖觋埸谘萏蛄绲崞瓠逭脶硇脬蚺埽隈欷勖铘舳菝萆惝脞羝偾袼牿焓" & _
  132.             "觖氪骒舻稆猡堋铫硎鸺厣蚰埴菹骖眵铞鸸唪艴阍趼硭喵猊聍胬硗圊赇唼铴掭阌菥帻,"
  133. Str = Str & "就等提量强最期程道然集联销税装确策斯港款富越游落善牌超属曾普景湖编黑遇筑短登湾" & _
  134.             "喜温棉奥朝博幅街植韩遍践童散谢雄惠答趋握储智辉裁鲁硬塔遗森掌董跑厦缓尊痛援渡雅" & _
  135.             "阔番棋敬赔裕殖惯循释暂铺窗赏锋替滑焦媒揭骗寒彭锁辈锅剩敦喝缘隔蒋滞琛滋舒割悲琴" & _
  136.             "堡斌稀惩傅裂铸奠湘葡搭逾跌插赋堤蒂惑堪晶喷窝疏慨晰竣紫缆喊湿禽锐帽屡逼缔稍雇欺" & _
  137.             "琼棚渴揽鼎葬粤筋寓赌缅艇葛渤暑椅喀谦腔喻御链愤睐裤搜傲募琳翔敞腊愧溉斑禄鹅湛厨" & _
  138.             "硫棒辜毯遏愉棵骚遂椒馈雁喂筒渣晴筛葱皖羡粪猴趁裙锈渝喉慌焰琦棍傍氯琢禅溃煮硝喘" & _
  139.             "氮棠喇缉凿喧谣锌椰棘斐畴焚粟缕琪搁遐筝脾嵌痪跋堰隙蛙窜腕棕粥搅渭葆辍蛮瑛舜赐犀" & _
  140.             "媚嫂揣尴椎葫傣窘惹翘腑祺媛雯惶婷絮棣惫皓湄隘摒愣窖筐棺棱葵釉缎痫酥锄湃渲蛟弼寐" & _
  141.             "啼渺颍揪琶辊溅琵喃婿蜒酣鱿腈氰揉谤搀赎蛛腌铿湟扉晾跚搓滁湍鹃搂葩渥壹睬萱掣覃惰" & _
  142.             "谧谟筵殚幄焱筏淼掰鹄痞婺貂啻唾猩琥阑蛤厥愕飨徨嵘颊椭琮犊琬嗒甥崴馋琨腆牍猾榔赓" & _
  143.             "锂锑喳耋傩遒畲崽蜓湮靓揩遁锃痢喽雳戟惴嗖喋琰锆腋嵋葺飓喟傈亵嵇焙惺蛰锏喔缄颌搔" & _
  144.             "缃湎跛跎缈腴揍揖蛐嗟颉跆遑趄揿腓睑锉喙啾猥孳腱锒孱萼椁琚揄傥喹巽嵯揆葳馊焯犄椐" & _
  145.             "猬骛痣蛭觞谡痘蛔痤蛳毽喱溆皴晷搽跗嵬愠筚棰痨鹂辇黍聒痧辋戢阕竦揠锇犍硷椤腚鲂椋" & _
  146.             "谠棼阒翕鼋喑瓿遄椟湫谥耜鹇铼舾辎愎酢葭颏铽嵛楮毳堞葑猢缗葶葸鹆矬缑跞裢裣嵝蛴蛩" & _
  147.             "巯葚喁棹锕媪傧鹁觚赍湔蒉蒌幂愀鹈裎裥愦脔湓飧酡粞欹彘嵫耠殛跏蛱缂喾蛞稂塄詈猱葜" & _
  148.             "锓筌弑缌睃缇硪痦揸絷跖粢揞馇睇稃酤缋锔锍蛑蛲溲舄渫揎蛘崾黹缒缏猹蒇觌揲堠楗喈犋" & _
  149.             "锎蒈筘铹锊猸甯蒎裒椠毵赕筅葙堙掾骘腙,"
  150. Str = Str & "新路意解想数源群感照满搞粮置福献像督输楼签罪煤简筹誉障鼓摄幕微署瑞零跨蒙鉴禁键" & _
  151.             "鹏雷塞勤锦盟错摆塑龄廉跟聘跳辑摊概蓄腾煌蓝触锡楚辞频滨愈辟碍摇滚赖毁溪暖滩填搬" & _
  152.             "摸搏漠颖暗碑腿睡蓬墓滥腰睛携遥塘慎辐腹碰酬嫁缝碗魂碎鼠谨催慈蜂碘遣殿溢蒸愁睹雾" & _
  153.             "韵鲍塌瞄嫌溶魁缚跻叠肆睦窟锣缠酱蒜溜傻榆蓉靖滔愚罩躲瑰歇痴碌媳蒲瑟暇腺锭锤矮雏" & _
  154.             "蜀虞寞稚楠槐裔滇腻詹畸楷溯漓裸嗓跪裘舅榄酯滤廓瑜煎锚窦溥滦慑雍痹缤煞槌媲锯睫剿" & _
  155.             "寝楂颐靳筷猿稠窥跤椿嵩褚锰楞靶瑙鹊嗜溺甄谬腥酰粱嗣锥衙瑚痰幌牒雹蓦筱蛾靴蓓瘀鄙" & _
  156.             "瘁馏馍斟蒿锢塬蓟遨搪酮楣煦溧颓筠榈蜕裨缜阙嗅硼煜楹嫉裱瑕嗷嗡暄煲嘟溴褂嗦蜗跷稞" & _
  157.             "骞椽剽鄢鄞睢酪腼嵊愫猷蒯腮遛煊粳锗阖溟鲅缙楫雉痼畹蛹禀楝鹉滢蓖锨蓥鹑酩犟滂蜃稣" & _
  158.             "蜇鹌谩稔韫跺嗨溘碓摈搐骝窠嗯楔颔媾嗬搡觎碉嗄嗤嗑锟嗪鲈骜粲皙馐谪碜塍蜍麂歆趔嗔" & _
  159.             "豢蜈稗痱貉跹氲蜉龃訾滟蒡痿滓摁蓊煅觥毂碚蓑瑗嗫碇肄锱瑁羧誊楦嫒裾缛缢槎榇嗲鲇碛" & _
  160.             "韪滏榘椴戡嗵煨瘐辏缟艉腭嗝嫫溱蓁溽裟嗳跸楸腧阗暌蒗蜊艄遢鲐鄣锛榉飕骰嗥跬睨筲趑" & _
  161.             "睥嫔跫溏锝彀蒺旒榀椹媸雎蓠腩筢辔蛸毹嗌龅蒽锪嵴锬睚徭廒腠鲋髡缡搦鲆筮溻滗煸裰筻" & _
  162.             "鲎煳搛缣鹋愍犏愆嗍蒴跣蓣鹎瘅溷蒹谫敫锩锘锖摅嗉裼禊貅罨媵搌傺搋楱戥戤塥遘骱锞耢" & _
  163.             "漭貊锫慊蜣蓐歃骟滠蓍搠龆煺腽瘃觜,"
  164. Str = Str & "管精需境模赛算稳察演愿歌鲜舞聚腐旗疑端缩静遭豪貌截慢墙酸漫赚寨辖嘉璃舆赫彰颗摘" & _
  165.             "漏榜熊磁蔡谱慕漂弊锻膜酿敲碧谭磋魅嫩酷碱廖竭滴翠隧魄瘦鼻辣潇漆碳熙瑶肇膏墅蔓誓" & _
  166.             "蜜摔膀嘛歉兢蔚蔗踊潍蜡寥熏遮韶粹裹熬寡摧缪漳僧蔽镀髦僚熔潢慷翟嘎榻凳嫖殡酶碟酵" & _
  167.             "镁暮漯墟馒裴韬膊榨憨蝇毓榕臧蝉熄孵辗榴锲蜚摹褐漾撂睿榭瞅瘟锹蔼鄯蜿摞雌瘩缫槛鄱" & _
  168.             "煽斡锵箔裳缨撇鲟漱蔑嘘嘀褪踌翡槟鹜厮蔺骡嘈漩箍赘粼霆塾漕睽罂嫣旖辕嗽碴蜘墒锶箫" & _
  169.             "漪嶂箩粽滹銮鼐锷榷漉蜷箕蔷蜻嫦镂碣幔阚霁螂褓榫谲褛嫡蔫瘘踉箐綦睾儆锴缥舔蓿膑僳" & _
  170.             "鹗嘣獐幛榛暧碲鲑靼蝈戬骷嘤龈蔻蜥蓼慵箸潋馑罱獒鹘骶谰雒嘧酽蔸槁鲛瘙翥蜢鹚箪箬褙" & _
  171.             "暝骠犒踅窨骢榧嘏谯僮墉箦摺褡赙跽缦鲞蜴酲嫘嘌綮嫱屣龇膈箧瑷蔟廑蕖鞅夤潴瘕瘌熘嘁" & _
  172.             "嗾碡箅僦箜缧酹嘞镅糁酾槊瘗蜮摭墚墁罴蜱榍锺槠褊榱蜾鹕漶鲚僬嫠膂瞀麽蔌鲔僖碹窬魃" & _
  173.             "碥瘥澉槔搿觏瘊夥僭窭劂甍艋耥箨寤锿锸鲕镄撖锾鲒獍漤蔹鹛蜞搴箝劁銎锼瞍觫瑭慝蜩酴" & _
  174.             "蓰撄潆箢谮嫜禚,"
  175. Str = Str & "增题镇德影额靠潮播澳篇熟潜震箱暴蔬摩鞋趣黎稿横墨遵撤毅履懂稻慰慧踏潘撞踪颜箭飘" & _
  176.             "豫撒撑糊撰聪橡艘幢醉樊潭蕴瘤鞍鹤澜暨霉嘱稽醇躺澄踢瘫趟僵蝶槽僻磊镑稼谴蕉滕磅瞒" & _
  177.             "墩膝敷樱獗翩踩撕熠璀醋蝴樟褒橄缭劈凛澎篆瞎擒璜瘠碾缮霄嘲噶璋踞澈镍瑾璇憬憧镌磕" & _
  178.             "镐嬉褥膛潼蝎鲤骸熨撬蝗潺稷撩撮撷磐嘿辘遴骼嘻篓蕃嘶蕙箴憎蕊蕨噢噙嘹暹儋憔麾觑懊" & _
  179.             "潸撵鲨鲫瘪澍噜糅镉潦膘豌幡聩嶙瞌噎醚瞑踝戮褴篑鲢髯寮墀蝠耦鞑嘭蝙缬觐镒赭噔蕤镓" & _
  180.             "蕲畿踮龉翦噌蝣糌虢蝌樯馔瘢靥篁勰龊撸魇踟镊鹞踯嶝噘撅稹徵蝮噗颛颚耧蝼嘬糍羯獠熳" & _
  181.             "镆艏廛镏镔樗撺鋈璎踔鲩鲥磔磙醌蝥醅赜鲧熵蕈牖氅篌槿馓羰髫餍谵蝽鲠槲鲣踺鲡蝻槭樘" & _
  182.             "骣觯蕞褫璁糇骺齑鹣噍瘼潲澌谳窳缯瘛幞蝰镎鞒蝤糈橥踣劐蕺屦瞢蝾磉螋鲦儇蝓膣踬撙,"
  183. Str = Str & "整器融激赞衡操避邀餐缴薄醒燃糖默篮凝赠镜穆燕壁磨膨雕辩薪懈嘴擅霍憾冀儒薛翰蕾噪" & _
  184.             "濒辨糕黔颠撼臻瘾懒霖擂薯篷蹄澡薇踵糙鲻橙霓燎辙膳罹擎憋璞橱寰篱噬禧鲸瞥斓镛瓢螃" & _
  185.             "潞噩瞰磺瞠澧獭憩镖羲窿霏翱篡擞歙缰熹醛樵嬗噼赝瘸篝飚濂褶橘鹦濉磬霎踱飙鞘蟒瘴螨" & _
  186.             "蹉蹂踹镗擀橇鲶鹧鲲螯蟆隰篦踽燧鲷遽邂鲳镝橹樨噱澹濑靛盥蕻廪螟穑樽髻鲵圜篙壅薮噻" & _
  187.             "薜霈殪甑辚颞噤瞟暾薏镞橛橐樾錾醍瘳缱鲭憷徼蹁噫鲱醐氇镙氆薅翮魉嬴瘿橼鲮瘰镘耪螅" & _
  188.             "甏篪膦颟澶聱癀麇薤髹瘵髭黉鹨嬖螭燔鲴篥癃擗褰颡螗蕹廨獬镟螈瘭鹾蹀憝篚嚆薨缳擐墼" & _
  189.             "耩懔鞔耨缲檎螓檠鼽糗磲鲺魈醑劓燠膪麈鄹鲰,"
  190. Str = Str & "藏繁徽赢戴癌霞瞩蹈魏骤翼擦磷襄臂螺瞬霜礁曙穗燥瞧糟簇鞠豁璨爵蹊朦藉鳄簧邃壑瞪濮" & _
  191.             "懋燮檐赡羁膺糠檀麋孺蹒檬臃濡黛薹璐壕薰黝臆辫糜懦嚓罄龋蟋蟀臀嚎簌藐濠瞳擘襁鼾镣" & _
  192.             "篾蟑镢蹋鹫鳅懑謇蹇邈疃濯藁蹑黜嚏藓嚅膻螳翳磴儡檩檄鳇擢龌罅嶷黏檗蟥鳊镫臊鹬鳃酆" & _
  193.             "臌濞蟊镦豳髁魍鼢镧螫繇罾礅臁髀簋觳鹪镥皤镨镪醣篼簖鹩簏嬷縻鍪貔擤螽癍螬鲽馘隳瞵" & _
  194.             "甓螵璩獯龠艚镡镩鲼黻鳆醢檑貘嬲镤薷鳋蟓,"
  195. Str = Str & "翻覆鞭鹰藤瞻彝襟瀑璧嚣藜鳌藕镭藩蹦瞿戳鹭躇癖癜镰镯馥懵鬃鞣蟠鎏鳍曜黠簪黟鳏颢蹙" & _
  196.             "髅癞蹩燹醪簟邋髂鏊餮镱鞯礓癔蟮檫簦鳎雠瞽蟪糨曛鼬艟镬蟛鬈鹱鳐冁鞫礞謦,"
  197. Str = Str & "警疆爆攀蟹曝蹲颤簿鳖靡藻攒麓蘑鳗瀚瓣巅簸蹬骥瀛麒蹴羹鏖癣蹼蟾孽蹶髋籁蹭霭羸蹿蘅" & _
  198.             "醮瀣鳕酃蹰鳙嚯藿缵谶镲髌鳓魑蠖蠓蘧鼗黢霪鞴蹯蠊艨醯籀襞鳔醭鞲礤黼攉鬏蠃鳘麴襦,"
  199. Str = Str & "籍灌耀壤魔馨巍躁纂鳞攘譬嚼嚷曦鬓糯鳝矍蠕镳孀醴鳟骧鳜蘖瓒躅黧獾鼯璺黩蘩霰瀵鼍瀹蠛黥黪醵颥," & _
  200.             "露霸赣髓癫礴黯蠢麝灏蠡霹夔颦躏醺曩鼙禳鳢羼鐾爝," & _
  201.             "囊镶蘸瓤霾懿鹳鬻饕穰饔耱氍躐蘼躔髑," & _
  202.             "罐麟攥攫癯颧鬟蠲鼹鼷趱齄躜," & _
  203.             "鑫衢矗蠹灞襻戆躞," & _
  204.             "馕囔鬣纛攮," & _
  205.             "蠼"
  206. Rule = Split(Str, ",")  '将笔画分类字符串拆分放入数组中
  207. For T = LBound(Rule) To UBound(Rule)  '循环将各个字符作为key,笔画数作为item存入字典2中,用于后期判断使用
  208.     For I = 1 To Len(Rule(T))
  209.         Dic2(Mid(Rule(T), I, 1)) = T + UBound(Rule) + 1
  210.     Next I
  211. Next T
  212. With ActiveSheet  '针对活动工作表
  213.     Arr = .[a1].Resize(.Cells(.Rows.Count, 2).End(3).Row, 3).Value  '提取数据区内容到数组中
  214.     ReDim Result(LBound(Arr) To UBound(Arr), LBound(Arr, 2) To UBound(Arr, 2))  '定义结果数组与数据源数组一致
  215.     For T = LBound(Arr, 2) To UBound(Arr, 2)  '循环向结果数组中写入标题行
  216.         Result(LBound(Arr), T) = Arr(LBound(Arr), T)
  217.     Next T
  218.     For N = LBound(Arr) + 1 To UBound(Arr)  '循环数据源数组数据区各项
  219.         Str = Left(Arr(N, 2), 2)  '提取对应分类号的前两位
  220.         If IsArray(Dic(Str)) Then  '判断对应的字典项目的item项是否为数组(如果是数组,说明已经保存过至少一组数据)
  221.             Arrt = Dic(Str)  '提取出数组
  222.             ReDim Preserve Arrt(LBound(Arrt) To UBound(Arrt) + 1)  '将数组增加一项
  223.             Arrt(UBound(Arrt)) = N  '把目前对应的行号新增加的数组项中
  224.             Dic(Str) = Arrt  '将数组保存到字典对应项的item中
  225.         Else  '如果不是数组(即没有对应项的数据存在),则
  226.             ReDim Arrt(1 To 1)  '定义只有一项的数组
  227.             Arrt(1) = N  '将当前行号写入数组中
  228.             Dic(Str) = Arrt  '将数组保存到字典对应项的item中
  229.         End If
  230.     Next N
  231.     Arr2 = Dic.keys  '提取出字典对应的keys到数组中,便于循环提取
  232.     B = LBound(Result) + 1  '初始化结果数组对应行号为标题行的下一行
  233.     For N = LBound(Arr2) To UBound(Arr2)  '循环字典各项
  234.         If IsArray(Dic(Arr2(N))) Then  '如果对应key的item项是数组(即有保存数据),则
  235.             Arrt = Dic(Arr2(N))  '提取出数组内容
  236.             If UBound(Arrt) > 1 Then  '如果数组不只一项内容,则进行排序
  237.                 For I = LBound(Arrt) To UBound(Arrt) - 1  '冒泡排序法
  238.                     For T = I + 1 To UBound(Arrt)
  239.                         If Arr(Arrt(I), 2) <> Arr(Arrt(T), 2) Then  '当分类号不相同时依分类号进行排序
  240.                             L = IIf(Len(Arr(Arrt(I), 2)) > Len(Arr(Arrt(T), 2)), Len(Arr(Arrt(I), 2)), Len(Arr(Arrt(T), 2)))  '提取出分类号中最长的字符串长度
  241.                             For R = 3 To L  '循环依排序规则比较各个字符
  242.                                 If Dic2(Mid(Arr(Arrt(I), 2), R, 1)) > Dic2(Mid(Arr(Arrt(T), 2), R, 1)) Then  '当序号大于比较项时交换数组中两个行号并退出循环
  243.                                     A = Arrt(I)
  244.                                     Arrt(I) = Arrt(T)
  245.                                     Arrt(T) = A
  246.                                     Exit For
  247.                                 ElseIf Dic2(Mid(Arr(Arrt(I), 2), R, 1)) < Dic2(Mid(Arr(Arrt(T), 2), R, 1)) Then  '小于时不用进行下一字符比较,直接退出
  248.                                     Exit For
  249.                                 End If
  250.                             Next R
  251.                         ElseIf Arr(Arrt(I), 3) <> Arr(Arrt(T), 3) Then  '如果分类号相同而书名不同时,依书名笔画数规则进行排序
  252.                             L = IIf(Len(Arr(Arrt(I), 3)) > Len(Arr(Arrt(T), 3)), Len(Arr(Arrt(I), 3)), Len(Arr(Arrt(T), 3)))  '取得书名中最长的书名字符数
  253.                             For R = 1 To L  '循环比较书名各个字符
  254.                                 If Dic2(Mid(Arr(Arrt(I), 3), R, 1)) > Dic2(Mid(Arr(Arrt(T), 3), R, 1)) Then  '笔画数大于比较项时交换数组对应项并退出循环
  255.                                     A = Arrt(I)
  256.                                     Arrt(I) = Arrt(T)
  257.                                     Arrt(T) = A
  258.                                     Exit For
  259.                                 ElseIf Dic2(Mid(Arr(Arrt(I), 3), R, 1)) < Dic2(Mid(Arr(Arrt(T), 3), R, 1)) Then  '小于时退出循环
  260.                                     Exit For
  261.                                 End If
  262.                             Next R
  263.                         End If
  264.                     Next T
  265.                 Next I
  266.             End If
  267.             For I = LBound(Arrt) To UBound(Arrt)  '排序完成后循环将数组中对应内容写入结果数组中
  268.                 For T = LBound(Arr, 2) To UBound(Arr, 2)
  269.                     Result(B, T) = Arr(Arrt(I), T)
  270.                 Next T
  271.                 B = B + 1
  272.             Next I
  273.         End If
  274.     Next N
  275.     .[k1].Resize(UBound(Arr), UBound(Arr, 2)) = Result  '结果数组写入结果数据区
  276. End With
  277. Set Dic = Nothing  '清空字典项目
  278. Set Dic2 = Nothing
  279. End Sub
详见附件及素材源帖.



【求助】图书分类号的排序与统计-示例文件.rar
2楼
tigeress		 不错的学习素材，收下，多谢了！
3楼
tongdm		 牛气！谢谢楼主分享！
4楼
龙吟		 代码好复杂，楼主大神啊！
5楼
gysegz		 真的好强悍，K哥，你真牛**！
6楼
lyf7276		 这简直是神的传说!!
7楼
老糊涂

免责声明

有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素， 经与ExcelTip.Net站长Apolloh商议并征得其同意， 现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示， 供有需要的人士查询使用，也慰缅曾经的论坛时代。 所示各个帖子的原作者如对版权有异议， 可与本人沟通提出，或于本站点留言，我们会尽快处理。 在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一

猜您喜欢
评论列表
搜索

鄂ICP备2021011689号-2

powered by emlog pro Theme By 蓝叶

sitemap