按汉字一二三四五六...排序

zhanglei1371

近来笔者在批量用word合并一些文档时遇到个问题，就是在插入第一章、第二章时，无法自动按章节顺序，而是按拼音顺序，因此思索良久，始终没有更好的方法
最后用如下代码解决了问题。代码是用很机械的方法完成的。仅适用于100内的情况
作为讨论，各位看看有没更好的方法和代码，如有更好更快的思路及代码，可跟帖提供，共同学习。

1. Sub 按一二三四五六七八九十排序()
   
2. on error resume next
   
3.     arr = Array("100#一百", "099#九十九", "098#九十八", "097#九十七", "096#九十六", "095#九十五", "094#九十四", "093#九十三", "092#九十二", "091#九十一", _
   
4.                 "090#九十", "089#八十九", "088#八十八", "087#八十七", "086#八十六", "085#八十五", "084#八十四", "083#八十三", "082#八十二", "081#八十一", _
   
5.                 "080#八十", "079#七十九", "078#七十八", "077#七十七", "076#七十六", "075#七十五", "074#七十四", "073#七十三", "072#七十二", "071#七十一", _
   
6.                 "070#七十", "069#六十九", "068#六十八", "067#六十七", "066#六十六", "065#六十五", "064#六十四", "063#六十三", "062#六十二", "061#六十一", _
   
7.                 "060#六十", "059#五十九", "058#五十八", "057#五十七", "056#五十六", "055#五十五", "054#五十四", "053#五十三", "052#五十二", "051#五十一", _
   
8.                 "050#五十", "049#四十九", "048#四十八", "047#四十七", "046#四十六", "045#四十五", "044#四十四", "043#四十三", "042#四十二", "041#四十一", _
   
9.                 "040#四十", "039#三十九", "038#三十八", "037#三十七", "036#三十六", "035#三十五", "034#三十四", "033#三十三", "032#三十二", "031#三十一", _
   
10.                 "030#三十", "029#二十九", "028#二十八", "027#二十七", "026#二十六", "025#二十五", "024#二十四", "023#二十三", "022#二十二", "021#二十一" _
    
11.         , "020#二十", "019#十九", "018#十八", "017#十七", "016#十六", "015#十五", "014#十四", "013#十三", "012#十二", "011#十一", "010#十", "009#九", _
    
12.                 "008#八", "007#七", "006#六", "005#五", "004#四", "003#三", "002#二", "001#一")
    
13.     With Application.FileDialog(1)
    
14.         If .Show <> -1 Then Exit Sub
    
15.         For Each f In .SelectedItems
    
16.             For i = 0 To UBound(arr)
    
17.                 If InStr(bn, Split(arr(i), "#")(1)) Then
    
18.                     strA = Replace(f, Split(arr(i), "#")(1), Split(arr(i), "#")(0)) & "@@" & f + vbNewLine + strA
    
19.                     Exit For
    
20.                 End If
    
21.             Next
    
22.         Next
    
23.     End With
    
24.     Set fso = CreateObject("scripting.filesystemobject")
    
25.     fso.createtextfile("c:\tem$.txt", True).write strA
    
26.     Shell "cmd /c type c:\tem$.txt|sort>c:\tem2.txt"
    
27.     strB = fso.opentextfile("c:\tem2.txt").readall
    
28.     Set fso = Nothing
    
29.     arr2 = Split(Left(strB, Len(strB) - 1), vbCrLf)
    
30.     For Each m In arr2
    
31.         ActiveDocument.Content.InsertAfter Split(m, "@@")(1) + Chr(13)
    
32.     Next
    
33.     Kill "c:\tem*.txt"
    
34. End Sub
    

复制代码

此外，最近遇到个奇怪的文档，全选----清除格式居然无法完成，有兴趣的可以看看是什么原因造成的：


补充内容 (2014-8-4 10:29):
17行的bn改为f

loquat

占位，有空再看。

kxzxw

用wps全选——清除格式，没有问题。word的bug?

fengbin7506

可以清除的呀。

loquat

我用的2007，也不能清除

sqhsqhli

关于代码，中文转数字可以做个转换函数（类似财务金额转换的那样），不用穷举。要求不大看得明白，17行的bn怎么来的

loquat

sqhsqhli 发表于 2014-8-4 09:38
关于代码，中文转数字可以做个转换函数（类似财务金额转换的那样），不用穷举。要求不大看得明白，17行的bn ...

其实主要是这个函数比较麻烦，需要写点代码，可能技术不够呵呵

sqhsqhli

已经有人创新了：http://club.excelhome.net/thread-974120-1-1.html

Preeza

谢谢！！！！