技术手段VBA之按照任意顺序对sheet进行排序获取当前sheet列表手动修改顺序按照修改后的顺序进行排序

59 阅读 0 评论 39 点赞

我是靠谱客的博主淡然咖啡豆，最近开发中收集的这篇文章主要介绍技术手段VBA之按照任意顺序对sheet进行排序获取当前sheet列表手动修改顺序按照修改后的顺序进行排序，觉得挺不错的，现在分享给大家，希望可以做个参考。

概述

获取当前sheet列表

Sub GetSheetList()
    Dim sht     As Object       '// sheet
    Dim s       As String       '// 追加sheet名
    Dim i       As Long         '// loop count
    
    '// 追加sheet
    Call Sheets.Add(After:=Sheets(Sheets.Count))
    s = "AddSheet"
    ActiveSheet.Name = s
    ActiveSheet.Activate
    ActiveSheet.Range("A1").Select
    
    '// loop worksheet
    For Each sht In Sheets
        '// 不是追加sheet的场合
        If (sht.Name <> "AddSheet") Then
            '// 把sheet名拷贝到追加sheet
            ActiveCell.Offset(i, 0).Value = sht.Name
        End If
        
        i = i + 1
    Next
End Sub

在这里插入图片描述

手动修改顺序

在这里插入图片描述

按照修改后的顺序进行排序

Sub ChangeOrder()
    Dim ar()    As String       '// sheet名数组
    Dim i       As Integer      '// loop count
    Dim s       As String       '// cell值
    
    Sheets("AddSheet").Select
    Sheets("AddSheet").Activate
    Range("A1").Select
    
    i = 0
    ReDim ar(i)
    
    '// loop A列
    Do
        '// cell值取得
        s = ActiveCell.Offset(i, 0).Value
        
        '// cell值为空的场合
        If (s = "") Then
            '// 跳出loop
            Exit Do
        End If
        
        '// 把sheet名放到数组中
        ReDim Preserve ar(i)
        ar(i) = s
        
        i = i + 1
    Loop
    
    '// 按照AddSheet的顺序排列
    i = 0
    Do
        '// 数组要素为空
        If (i > UBound(ar)) Then
            '// 跳出loop
            Exit Do
        End If
        
        '// 将数组当前循环值的表名移动到当前循环计数器值的右侧
        Sheets(ar(i)).Move before:=Sheets(i + 1)
        
        i = i + 1
    Loop
    
    '// 删除的确认对话框不表示
    Application.DisplayAlerts = False
    
    '// "AddSheet"sheet删除
    Sheets("AddSheet").Delete
    
    Application.DisplayAlerts = True
End Sub