CÔNG TY CỔ PHẦN BLUESOFTS

/ Lập trình VBA / cơ bản / Sắp xếp thứ tự các sheet trong Excel bằng VBA

Sắp xếp thứ tự các sheet trong Excel bằng VBA

Một file Excel với nhiều sheet mà tên của nó không được sắp xếp theo trình tự sẽ khó quản lý. Sau đây tôi chia sẻ với các bạn phương pháp sắp xếp các sheet theo tên tăng dần hoặc giảm dần bằng VBA.

(Học lập trình VBA trong Excel cơ bản và nâng cao)

1. Mở file Excel cần sắp xếp các sheet. Copy code VBA

Vào môi trường VBA - Nhấn ALT+F11, vào menu Insert->Module, tại cửa sổ Module copy đoạn code dưới đây dán vào

'Bắt đầu COPY codes-----------------

'Tac gia: tuanktcdcn@yahoo.com - Tel: 0904.210.337
'Website: http://bluesofts.net

Sub Sapxep()
    Dim x As VbMsgBoxResult
    x = MsgBox("Chon cach sap xep ten sheet:" & vbNewLine & _
               """Yes"" - Tang dan" & vbNewLine & _
               """No"" - Giam dan" & vbNewLine & _
               """Cancel"" - Khong lam gi.", vbQuestion + vbYesNoCancel, "Sap xep Sheet tren tap tin Excel dang mo")

    If x = vbCancel Then
        Exit Sub
    End If

    Dim TraLoi(6 To 7) As String
    TraLoi(6) = "tang dan" ' vbYes
    TraLoi(7) = "giam dan" ' vbNo

    SapxepSheet ActiveWorkbook, x = vbYes
    MsgBox "Cac sheet da duoc sap xep " & TraLoi(x), vbInformation

End Sub

Sub SapxepMang(ByRef mList, Optional ByVal Tangdan As Boolean = True)
    'Xep thu tu cua mang
    Dim nDong As Long, nCot As Long, I As Long, J As Long

    nDong = UBound(mList, 1)
    If nDong > 0 Then
    Dim cMin, cMin2 As String

    For I = 1 To nDong
        cMin = mList(I)
        For J = I + 1 To nDong
            If Tangdan Then
                If StrComp(UCase(mList(J)), UCase(cMin)) < 0 Then
                    cMin2 = cMin
                    cMin = mList(J)
                    mList(J) = cMin2
                End If
            Else 'Giam dan
                If StrComp(UCase(mList(J)), UCase(cMin)) > 0 Then
                    cMin2 = cMin
                    cMin = mList(J)
                    mList(J) = cMin2
                End If
            End If
        Next J
        mList(I) = cMin
    Next I
    End If
End Sub

Sub SapxepSheet(ByRef OnWorkbook As Workbook, Optional ByVal Tangdan As Boolean = True)
    On Error GoTo Done:
    Dim WS As Worksheet
    Dim n As Long
    n = OnWorkbook.Sheets.Count
    ReDim ListSH(n)
    I = 0
    For Each WS In OnWorkbook.Sheets
        I = I + 1
        ListSH(I) = WS.Name
    Next
    Application.ScreenUpdating = False
    Application.EnableEvents = False

    SapxepMang ListSH, Tangdan

    For I = 1 To n - 1
        OnWorkbook.Sheets(ListSH(I)).Move Before:=OnWorkbook.Sheets(ListSH(n))
    Next I
Done:
    Application.ScreenUpdating = True
    Application.EnableEvents = True
    Set Sh = Nothing
End Sub