快速重排同一个工作簿里工作表的标签顺序

szqhb

一个工作簿里的多个工作表是杂乱排序的，如何快速重排同一个工作簿里工作表的标签顺序，如图例按照一年级1班、2班……二年级1班、2班……六年级1班、2班…… 例子.zip (32.12 KB, 下载次数: 8)

2024-10-8 18:06 上传

点击文件名下载附件

小凡、、、

ynzsvt

在要排序的工作簿上运行代码文件的代码。

cidanji

在要排序的簿里运行

1. Sub ss()
   
2. Dim s$, n&, i&, j&
   
3. For i = 1 To 9
   
4.     For j = 1 To 9
   
5.         s = Mid("一二三四五六七八九", i, 1) & j & "班"
   
6.         If hasWs(s) Then n = n + 1: Sheets(s).Move Sheets(n)
   
7.     Next
   
8. Next
   
9. End Sub
   
10. Function hasWs(WsName) As Boolean
    
11. On Error Resume Next
    
12. hasWs = Sheets(WsName).Name = WsName
    
13. End Function

复制代码

quqiyuan

参与一下，仅供查看。。。

quqiyuan

代码如下。。。
Sub test()
    Application.ScreenUpdating = False
    s = Split("一 二 三 四 五 六 七 八 九 十 十一 十二")      '年级数最大数字，不一定是这么多年级，可以随意多写
    Num = 8                                                   '班级数最大数字，不一定是每个年级都有那么多班，写最多的即可,可以随意多写
    Set D = CreateObject("scripting.dictionary")
    For Each Sh In ThisWorkbook.Worksheets
        D(Sh.Name) = ""
    Next
    For i = 0 To UBound(s)
        For j = 1 To Num
            Str1 = s(i) & j & "班"
            If D.exists(Str1) Then
                n = n + 1
                ThisWorkbook.Sheets(Str1).Move Before:=ThisWorkbook.Sheets(n)
            End If
        Next
    Next
    Set D = Nothing
    Beep
    Application.ScreenUpdating = True
End Sub
   

szqhb

quqiyuan 发表于 2024-10-8 19:51
代码如下。。。
Sub test()
    Application.ScreenUpdating = False

非常感谢。万分感谢！

szqhb

cidanji 发表于 2024-10-8 18:38
在要排序的簿里运行

非常感谢。万分感谢！

szqhb

cidanji 发表于 2024-10-8 18:38
在要排序的簿里运行

非常感谢。万分感谢！

szqhb

小凡、、、 发表于 2024-10-8 18:22

非常感谢。万分感谢！
你这个代码很好，可以在“工作表标签排序规律里”点击按钮来运行宏重排。如果只对当前打开的包含“订餐明细”的工作表进行排序，怎么修改代码？？