请问如何对工作表按照工作表名进行排序？

剑少

你好，我运行该宏出现下标越界，怎么回事，急

凤翅云龙

不太懂，在2010里老是不听调试

骑马的火柴人

拿来主义，哇哈哈哈

xopo

是啊，只要宏运行过一次，再次排序将会出现下标出界的情况，不知道什么原因

chxw68

1. Sub test()
   
2.   Dim ws As Worksheet
   
3.   Dim arr
   
4.   Dim ss As String
   
5.   Dim i, j As Integer
   
6.   
   
7.   ReDim arr(1 To Worksheets.Count - 1)
   
8.   
   
9.   i = 0
   
10.   For Each ws In Worksheets
    
11.     If ws.Name <> "目录" Then
    
12.       i = i + 1
    
13.       arr(i) = ws.Name
    
14.     End If
    
15.   Next
    
16.   
    
17.   rr = UBound(arr)
    
18.   For i = 1 To rr - 1
    
19.     For j = i + 1 To rr
    
20.       If arr(i) > arr(j) Then
    
21.         ss = arr(i)
    
22.         arr(i) = arr(j)
    
23.         arr(j) = ss
    
24.       End If
    
25.     Next
    
26.   Next
    
27.   
    
28.   For i = 1 To rr
    
29.     Worksheets(arr(i)).Move after:=Worksheets(rr + 1)
    
30.   Next
    
31. End Sub

复制代码

lbay

挺适用，收藏了！正适合多工作表的

烟松粼

高人在民间呀                  

香川群子

zldccmx 发表于 2008-11-25 21:33
稍微优化一下
Sub Zldccmx()
    Application.ScreenUpdating = False

搞什么飞机……有必要整那么复杂么？

看我的代码，【香川改进冒泡法排序】

1. Sub test() 'by kagawa
   
2.     u = Sheets.Count '工作表数量u
   
3.     r = 0 '记录r初始化
   
4.     For i = 2 To u - 1 '从第2表开始 (如果全部排序则从1开始)
   
5.         t = Sheets(i).Name '读取当前表名称
   
6.         For j = i + 1 To u '遍历直至最后
   
7.             If Sheets(j).Name < t Then t = Sheets(j).Name: r = j
   
8.             '比较并不断更新 找到名称最小的工作表序号，记入r
   
9.         Next
   
10.         If r > 0 Then Sheets(r).Move before:=Sheets(i): r = 0
    
11.         '如果r>0则表明 后面的第r表比当前i表的名称更小，所以把r表插入到当前i表之前，然后r初始化=0
    
12.     Next '继续后面的检查
    
13. End Sub

复制代码

呵呵，这个是最为简洁的代码了吧。

fayxiefei

请问可以按照目录中显示的表名顺序排序么？

xiaobaige

zldccmx 发表于 2008-11-25 21:27
Sub Zldccmx()
    Application.ScreenUpdating = False
    Application.EnableEvents = False

请高手帮我看一下吧，http://club.excelhome.net/forum. ... p;page=1#pid7849724