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

monkeyyd

请问如何对工作表按照工作表名进行排序？
请见附件： 工作表排序.rar (1.54 KB, 下载次数: 851)

2008-11-25 20:44 上传

点击文件名下载附件

zldccmx

Sub Zldccmx()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim Shname
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "目录" Then Shname = Shname & "," & sh.Name
    Next
    Shname = Split(Mid(Shname, 2), ",")
    With Sheets("目录")
        .Cells(1, 255).Resize(UBound(Shname) + 1, 1) = WorksheetFunction.Transpose(Shname)
        .Columns("IU:IU").Sort Key1:=.Range("IU1"), Order1:=xlAscending, Header:=xlGuess, _
                               OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                                                                                             :=xlPinYin, DataOption1:=xlSortTextAsNumbers
        .Cells(1, 256).Resize(UBound(Shname) + 1, 1) = "=row()+1"
        Shname = .Range([iu1], [iv1].End(xlDown))
        .Range([iu1], [iv1].End(xlDown)) = ""
    End With
    For i = 1 To UBound(Shname)
        Sheets(Shname(i, 1)).Move before:=Sheets(Shname(i, 2))
    Next
    Application.EnableEvents = True
End Sub

zldccmx

稍微优化一下
Sub Zldccmx()
    Application.ScreenUpdating = False
    Application.EnableEvents = False
    Dim Shname
    For Each sh In ThisWorkbook.Worksheets
        If sh.Name <> "目录" Then Shname = Shname & "," & sh.Name
    Next
    Shname = Split(Mid(Shname, 2), ",")
    With Sheets("目录")
        .Cells(1, 256).Resize(UBound(Shname) + 1, 1) = WorksheetFunction.Transpose(Shname)
        .Columns("IV:IV").Sort Key1:=.Range("IV1"), Order1:=xlAscending, Header:=xlGuess, _
                               OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                                                                                             :=xlPinYin, DataOption1:=xlSortTextAsNumbers
        Shname = .Range([iv1], [iv1].End(xlDown))
        .Range([iv1], [iv1].End(xlDown)) = ""
    End With
    Sheets("目录").Move before:=Sheets(1)
    For i = 1 To UBound(Shname)
        Sheets(Shname(i, 1)).Move before:=Sheets(i + 1)
    Next
    Application.EnableEvents = True
End Sub

[ 本帖最后由 zldccmx 于 2008-11-25 21:35 编辑 ]

kepeng100

老朽,真是太有材了,真正的专业,佩服!

zldccmx

呵呵，楼上的过奖了!
为了便于阅读和理解代码的思路，特意加上注释：
Sub Zldccmx()
    Application.ScreenUpdating = False'关闭屏幕实时更新
    Application.EnableEvents = False'暂停系统事件响应
    Dim Shname '定义一个变量
    For Each sh In ThisWorkbook.Worksheets '遍历当前工作簿下的所有工作表
        If sh.Name <> "目录" Then Shname = Shname & Chr(1) & sh.Name '除了指定的“目录”工作表以外，其它各工作表的名称记录到字符串Shname中，并用一个特殊的字符CHR(1)来作为分界符
    Next
    Shname = Split(Mid(Shname, 2), Chr(1)) '将字符串按既定的分界符拆分成一个一维数组
    With Sheets("目录")
        .Cells(1, 256).Resize(UBound(Shname) + 1, 1) = WorksheetFunction.Transpose(Shname) '将一维数组暂存到工作表"目录"的最后一列，然后借助工作表来对工作表名称进行排序
        .Columns("IV:IV").Sort Key1:=.Range("IV1"), Order1:=xlAscending, Header:=xlGuess, _
                               OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, SortMethod _
                                                                                             :=xlPinYin, DataOption1:=xlSortTextAsNumbers '执行排序，按升序排序
        Shname = .Range([iv1], [iv1].End(xlDown)) '将排序后的工作表名转存到数组Shname中，此时的数组已经变形成一个2维数组
        .Range([iv1], [iv1].End(xlDown)) = "" '清除刚刚借用的工作表部分区域
    End With
    Sheets("目录").Move before:=Sheets(1) '按题目要求，将工作表 “目录”放在首位
    For i = 1 To UBound(Shname)
        Sheets(Shname(i, 1)).Move before:=Sheets(i + 1) '依次移动工作表，由于此时的数组已经变形成一个2维数组，所以书写格式就是Shname(i,1)
    Next
    Application.EnableEvents = True'恢复系统事件响应
End Sub

zhengliqiang

哇~！~！漂亮~！~！

monkeyyd

谢谢老朽。你的技巧和注释都太棒了。自己才疏学浅，还要慢慢研究。
请问 您的升序和降序排列 与 对列数据进行升降序排列的原则是一样的吧

monkeyyd

谢谢老朽！
您的方法和注释都太棒了。我还在研究学习

cxz0919

您的方法和注释都太棒了

soarsoar77

老实说，我看不懂，能不能更浅显点的编程