You are here:: Các bài học hay VBA trong Excel Sắp xếp các sheet trong Excel tăng dần hoặc giảm dần
 
 

Sắp xếp các sheet trong Excel tăng dần hoặc giảm dần

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.

sapxepsheet

(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: Địa chỉ email này đã được bảo vệ từ spam bots, bạn cần kích hoạt Javascript để xem nó. - 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

'Kết thuc COPY codes-----------------

2. Sắp xếp các sheet trong file Excel đang mở

+ Nhấn ALT+F8 hiện ra cửa sổ Macro

+ Chọn macro "SapXep", chọn Run.

Chúc các bạn thành công trong công việc hơn cùng với kiến thức Excel luôn tăng lên không ngừng!

Tác giả: Nguyễn Duy Tuân - Công ty Cổ phần Bluesofts