如果 Excel 工作表数量较多而排列又没有规则时,很难快速地定位某个工作表,这时可以使用 Excel VBA 对工作表名称进行排序,以便于我们查找工作表。
按常规文本排序
本示例使用比较排序法首先对文本进行降序排序,再对各工作表按排序结果重新调整工作表的位置,从而实现将工作表按名称升序排序。VBA 代码如下所示:
Sub SortSheetByName()
Dim intSheetCount As Integer
Dim i As Integer, j As Integer
Dim strName As String, astrSheet() As String
'关闭屏幕刷新,提升运行速度
Application.ScreenUpdating = False
'获取工作表的数量并赋值给变量
intSheetCount = Worksheets.Count
'将动态数组调整为一维数组
ReDim astrSheet(1 To intSheetCount)
'将全部工作表名称保存在数组
For i = 1 To intSheetCount
astrSheet(i) = Worksheets(i).Name
Next i
'按从大到小的顺序对数组排序
For i = 1 To intSheetCount - 1
For j = i + 1 To intSheetCount
'将数组中相邻的两个数据进行比较,如果前一个数据比后一个数据小,则交换位置
If astrSheet(i) < astrSheet(j) Then
strName = astrSheet(i)
astrSheet(i) = astrSheet(j)
astrSheet(j) = strName
End If
Next j
Next i
'按排序后的数组顺序逐一移动工作表到第1个工作表之前
For i = 1 To intSheetCount
Worksheets(astrSheet(i)).Move Before:=Worksheets(1)
Next i
'开启屏幕刷新
Application.ScreenUpdating = True
End Sub
Worksheets 对象的 Move 方法将指定的工作表移到工作簿的另一位置,其语法格式如下:
Move (Before, After)
参数
名称 | 必需/可选 | 数据类型 | 说明 |
---|---|---|---|
Before | 可选 | Variant | 在其之前放置移动工作表的工作表。 如果指定了 After,则不能指定 Before。 |
After | 可选 | Variant | 在其之后放置移动工作表的工作表。 如果指定了 Before,则不能指定 After。 |
注意
如果既不指定 Before 也不指定 After,Microsoft Excel 将新建一个工作簿,其中包含所移动的工作表。
按数字部分排序
我们有时可能会使用“字符串+数字”或“数字+字符串”的形式作为工作表的名称。常见的就是每月数据的工作表,如:1月,2月,3月,一直到12月,按常规文本排序就无法满足我们的要求了。
以下示例代码按工作表名称中的数字升序或降序排列,可适应诸如:“数字+字符串”或“字符串+数字”或“字符串+数字+字符串”等形式的工作表名,VBA 代码如下:
Sub SortSheetByNumber()
'冒泡法排序工作表名
Dim arr, i%, j%, tempVal
Dim intSheetCount As Integer
Application.ScreenUpdating = False
intSheetCount = Worksheets.Count '工作表数量
ReDim arr(1 To intSheetCount, 1 To 2) '重定义二维数组
'二维数组赋值
For i = 1 To intSheetCount
arr(i, 1) = Worksheets(i).Name '工作表名
arr(i, 2) = Val(GetNumber(Worksheets(i).Name)) '工作表名中的数值
Next i
'冒泡法排序,相邻两个值比较,大的上浮,小的下沉
For i = UBound(arr) To LBound(arr) + 1 Step -1
For j = LBound(arr) To i - 1
If arr(j, 2) > arr(j + 1, 2) Then
tempVal = arr(j, 2)
arr(j, 2) = arr(j + 1, 2)
arr(j + 1, 2) = tempVal
tempVal = arr(j, 1)
arr(j, 1) = arr(j + 1, 1)
arr(j + 1, 1) = tempVal
End If
Next
Next
'工作表名升序排列
For i = intSheetCount To 1 Step -1
Worksheets(arr(i, 1)).Move before:=Worksheets(1)
Next i
' '工作表名降序排列
' For i = 1 To intSheetCount
' Worksheets(arr(i, 1)).Move before:=Worksheets(1)
' Next i
End Sub
Function GetNumber(Str As String)
'提取字符串中的数字
Dim s As String, t As String
Dim i As Long
s = ""
For i = 1 To Len(Str)
t = Mid(Str, i, 1)
If IsNumeric(t) = True Then
s = s & t
End If
Next i
GetNumber = s
End Function
第 11 行代码使用 Val 函数将自定义函数 GetNumber
提取出来的字符型数字转化为数值型,方便后面比较大小。
第 14 至 25 行代码,使用冒泡法排序,对相邻两个工作表名称中的数字进行比较,如果大值在上,小值在下,则位置不变,如果小值在上,大值在下,则交换两者位置,简单来说就是大的上浮,小的下沉。
如果需要降序排列,将第 28 至 30 行注释掉,第 33 至 35 行 取消注释。