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,其他不变。这里不再赘述。

 技术交流,软件开发,欢迎微信沟通:

  • 11
    点赞
  • 1
    收藏
    觉得还不错? 一键收藏
  • 0
    评论
评论
添加红包

请填写红包祝福语或标题

红包个数最小为10个

红包金额最低5元

当前余额3.43前往充值 >
需支付:10.00
成就一亿技术人!
领取后你会自动成为博主和红包主的粉丝 规则
hope_wisdom
发出的红包
实付
使用余额支付
点击重新获取
扫码支付
钱包余额 0

抵扣说明:

1.余额是钱包充值的虚拟货币,按照1:1的比例进行支付金额的抵扣。
2.余额无法直接购买下载,可以购买VIP、付费专栏及课程。

余额充值