VBA学习(50)：实现一键对所有工作表进行排序

要按名称对工作表进行排序，我们可以逐张选定某工作表，按住鼠标将该工作表拖放在所需的位置，从而实现工作表排序的效果。但如果工作表较多，手动拖放进行工作表排序，显然不是最有效率的方式。

为此，我们可以借助于VBA实现按工作表名称，一键对所有工作表进行升序或降序排列。

对工作表进行排序，首先要确认排序规则。本文主要是利用Excel筛选的升序降序规则。

以升序规则为例。Excel中筛选的升序规则：数字-->字母-->汉字。其中，数字从小到大排序；字母按A-Z排序；汉字按拼音排序。如果文本为数字+字母+汉字的组合，数字开头的文本-->字母开头的文本-->汉字开头的文本。如果文本第一个字符相同，则比较第二个字符，以此类推。

同理可知，Excel筛选的降序规则。了解Excel升序/降序的筛选规则后，我们就可以将Excel的筛选升序降序规则应用于工作表的排序。VBA的实现思路如下：

1.新建一个临时工作表，A列存储所有工作表名称，筛选升序/降序；

2.创建字典，存储A列排序后的工作表名以及对应的行号；

3.以行号作为工作表的排序依据，利用冒泡排序，冒泡式地移动工作表，从而实现所有工作表的升序排列。

工作表升序排列的VBA代码

Sub 按名称对工作表升序排列()
    Application.ScreenUpdating = False
    Application.DisplayAlerts = False
    '定义工作表名称的数组
    Dim shtArray() As Variant
    ReDim shtArray(ActiveWorkbook.Sheets.Count - 1)
    
    '在第一张工作表前新建临时表
    Sheets.Add before:=Sheets(1)
    Sheets(1).Name = "temp" & Format(Now, "yyyymmddhhmmss")

    '在临时表的A列存储所有工作表的名称
    Sheets(1).Range("a1") = "工作表名称"
    Dim sht As Worksheet, i As Integer
    i = 0
    For Each sht In Sheets
        If sht.Name <> Sheets(1).Name Then
            Range("a" & i + 2) = sht.Name
            shtArray(i) = sht.Name
            i = i + 1
        End If
    Next
    
    '在A列进行升序筛选
    Sheets(1).Columns("A:A").AutoFilter
    Sheets(1).AutoFilter.Sort.SortFields.Clear
    Dim rng As Range
    Set rng = Sheets(1).Range("A1:A" & Sheets(1).Range("a" & Rows.Count).End(xlUp).Row)
    Sheets(1).AutoFilter.Sort.SortFields. _
        Add2 Key:=rng, SortOn:=xlSortOnValues, Order:=xlAscending, _
        DataOption:=xlSortNormal
    With Sheets(1).AutoFilter.Sort
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    '以字典形式存储排序后的工作表名，和对应的行号
    Dim d As Object
    Set d = CreateObject("scripting.dictionary")
    For aaa = 2 To Range("a" & Rows.Count).End(xlUp).Row
        d(CStr(Range("a" & aaa).Value)) = aaa
    Next
    
    '利用冒泡排序，冒泡式地移动工作表
    For i = LBound(shtArray) To UBound(shtArray) - 1
        For j = i + 1 To UBound(shtArray)
            If Val(d(shtArray(i))) > Val(d(shtArray(j))) Then
                Sheets(shtArray(j)).Move before:=Sheets(shtArray(i))
                temp = shtArray(i)
                shtArray(i) = shtArray(j)
                shtArray(j) = temp
            End If
        Next j
    Next i
    '删除临时表
    Sheets(1).Delete
    Application.DisplayAlerts = True
    Application.ScreenUpdating = True
End Sub

要实现工作表降序排列，只要将上述代码中AutoFilter的Order参数改为xlDescending，其他不变。这里不再赘述。

 技术交流，软件开发，欢迎微信沟通：