要按名称对工作表进行排序,我们可以逐张选定某工作表,按住鼠标将该工作表拖放在所需的位置,从而实现工作表排序的效果。但如果工作表较多,手动拖放进行工作表排序,显然不是最有效率的方式。
为此,我们可以借助于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,其他不变。这里不再赘述。
技术交流,软件开发,欢迎微信沟通: