跳到主要内容

按名称对工作表进行排序

如果 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

按数字部分排序

我们有时可能会使用“字符串+数字”或“数字+字符串”的形式作为工作表的名称。常见的就是每月数据的工作表,如: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 行 取消注释。

评论

您的电子邮件地址不会显示出来。*号为必填项。