Sắp xếp các sheet theo thứ tự

Thảo luận trong 'Ứng dụng Excel' bắt đầu bởi Yeudoi, 7 Tháng mười một 2005.

2,822 lượt xem

  1. Yeudoi

    Yeudoi Thành viên thân thiết

    Bài viết:
    88
    Đã được thích:
    0
    Nơi ở:
    Hoi An Quang Nam
    Trước đây tôi có nghe ai đó hỏi về cách sắp xếp thứ thự các sheet nay tôi xin gửi một macro để các bạn dùng thử:

    Sub SortSheets()
    ' This routine sorts the sheets of the
    ' active workbook in ascending order.

    Dim SheetNames() As String
    Dim i As Integer
    Dim SheetCount As Integer
    Dim VisibleWins As Integer
    Dim Item As Object
    Dim OldActive As Object

    ' Check for protected workbook structure
    If ActiveWorkbook.ProtectStructure Then
    MsgBox ActiveWorkbook.Name & " is protected.", _
    vbCritical, "Cannot Sort Sheets"
    Exit Sub
    End If

    ' Disable Ctrl+Break
    Application.EnableCancelKey = xlDisabled

    ' Exit if no windows are visible
    VisibleWins = 0
    For Each Item In Windows
    If Item.Visible Then VisibleWins = VisibleWins + 1
    Next Item
    If VisibleWins = 0 Then Exit Sub

    ' Get the number of sheets
    SheetCount = ActiveWorkbook.Sheets.Count

    ' Redimension the array
    ReDim SheetNames(1 To SheetCount)

    ' Store a reference to the active sheet
    Set OldActive = ActiveSheet

    ' Fill array with sheet names and hidden status
    For i = 1 To SheetCount
    SheetNames(i) = ActiveWorkbook.Sheets(i).Name
    Next i

    ' Sort the array in ascending order
    Call BubbleSort(SheetNames)

    ' Turn off screen updating
    Application.ScreenUpdating = False

    ' Move the sheets
    For i = 1 To SheetCount
    ActiveWorkbook.Sheets(SheetNames(i)).Move _
    ActiveWorkbook.Sheets(i)
    Next i

    ' Reactivate the original active sheet
    OldActive.Activate
    End Sub



    Sub BubbleSort(List() As String)
    '‘ Sorts the List array in ascending order
    Dim First As Integer, Last As Integer
    Dim i As Integer, j As Integer
    Dim Temp

    First = LBound(List)
    Last = UBound(List)
    For i = First To Last - 1
    For j = i + 1 To Last
    If UCase(List(i)) > UCase(List(j)) Then
    Temp = List(j)
    List(j) = List(i)
    List(i) = Temp
    End If
    Next j
    Next i
    End Sub
     
    #1

Chia sẻ trang này