Sắp sếp các sheet theo thứ tự tăng dần theo lý trình cống

[simmung]

Em chào anh chị. Cho em hỏi chút em có file excel các cống các sheet được đặt tên theo lý trình từ km5-km10. hiện tại các sheet này chưa sắp sếp theo thứ tự tăng dần có cách nào dùng hàm hoạc VBA để sắp sếp các sheet theo thứ tự tăng dần không ạ. Em cảm ơn ạ. Dưới đây là tệp của nó

 

[Maika8008]

Dùng thử củ chuối này:

Option Explicit
Sub sapxepSheet()
Application.ScreenUpdating = False
Dim count&, i&, j&, k&, name As String, arr()
count = Sheets.count
ReDim arr(1 To count, 1 To 2)
For i = 1 To count - 1
    name = Sheets(i).name
   
    ' Doi ten sheet voi so km format dang "000" va luu tên cu lai
    If name Like "KM*+*" Then
        k = k + 1
        arr(k, 1) = name
        arr(k, 2) = "KM" & Format(Mid(name, 3, InStr(3, name, "+") - 3), "000") & Mid(name, InStr(3, name, "+"), 255)
        Sheets(i).name = arr(k, 2)
    End If
Next

'Sap xep tang dan
For i = 1 To count - 1
        For j = i + 1 To count
        If Sheets(j).name < Sheets(i).name Then
            Sheets(j).Move before:=Sheets(i)
        End If
    Next j
Next i

'Tra lai ten cho em
For i = 1 To count
    For j = 1 To UBound(arr)
        If Sheets(i).name = arr(j, 2) Then Sheets(i).name = arr(j, 1)
    Next
Next
Application.ScreenUpdating = True
End Sub

Code chạy ổn rồi nhưng có lẽ nên thay arr(k, 2) = "KM" & Format(Mid(name, 3, InStr(3, name, "+") - 3), "000") & Mid(name, InStr(3, name, "+"), 255)
bằng: arr(k, 2) = "KM" & Format(Mid(name, 3, InStr(1, name, "+") - 3), "0000") & Mid(name, InStr(3, name, "+"))
phòng khi có hơn 99 lý trình

 

[simmung]

Dùng thử củ chuối này:

Option Explicit
Sub sapxepSheet()
Application.ScreenUpdating = False
Dim count&, i&, j&, k&, name As String, arr()
count = Sheets.count
ReDim arr(1 To count, 1 To 2)
For i = 1 To count - 1
    name = Sheets(i).name
   
    ' Doi ten sheet voi so km format dang "000" va luu tên cu lai
    If name Like "KM*+*" Then
        k = k + 1
        arr(k, 1) = name
        arr(k, 2) = "KM" & Format(Mid(name, 3, InStr(3, name, "+") - 3), "000") & Mid(name, InStr(3, name, "+"), 255)
        Sheets(i).name = arr(k, 2)
    End If
Next

'Sap xep tang dan
For i = 1 To count - 1
        For j = i + 1 To count
        If Sheets(j).name < Sheets(i).name Then
            Sheets(j).Move before:=Sheets(i)
        End If
    Next j
Next i

'Tra lai ten cho em
For i = 1 To count
    For j = 1 To UBound(arr)
        If Sheets(i).name = arr(j, 2) Then Sheets(i).name = arr(j, 1)
    Next
Next
Application.ScreenUpdating = True
End Sub

em cảm ơn anh nhiều ạ. em chạy được rồi ạ.

 

[Maika8008]

Code này còn củ chuối hơn nhưng chạy được là được

Sub SortSheet()
    Dim Ws As Worksheet
    Dim i As Long, iSh As Long, Sh As Long, arr
    iSh = ThisWorkbook.Worksheets.count
    ReDim arr(1 To iSh, 1 To 2)
    Application.ScreenUpdating = False
    Application.Calculation = xlCalculationManual
    Application.EnableEvents = False
    For Each Ws In ThisWorkbook.Worksheets
        If Ws.name <> "TIEU DE" And Not Ws.name Like "THKL*" And Ws.name <> "DINH HINH" Then
            i = i + 1
            arr(i, 1) = Ws.name
            arr(i, 2) = "KM" & Format(Mid(arr(i, 1), 3, InStr(1, arr(i, 1), "+") - 3), "0000") & Mid(arr(i, 1), InStr(3, arr(i, 1), "+"))
        End If
    Next
    Sheet7.Range("AAA5").Resize(i, 2) = arr
    Sheet7.Range("AAA5").Resize(i, 2).Sort Key1:=Sheet7.Range("AAB5"), Order1:=xlAscending
    arr = Sheet7.Range("AAA5:AAB" & 4 + i).Value
    Sheet7.Range("AAA5").Resize(i, 2).ClearContents
    For Sh = i To 1 Step -1
        Sheets(arr(Sh, 1)).Move before:=Sheets(1)
    Next
    Application.ScreenUpdating = True
    Application.Calculation = xlCalculationAutomatic
    Application.EnableEvents = True
End Sub

 

[simmung]

Dùng thử củ chuối này:

Option Explicit
Sub sapxepSheet()
Application.ScreenUpdating = False
Dim count&, i&, j&, k&, name As String, arr()
count = Sheets.count
ReDim arr(1 To count, 1 To 2)
For i = 1 To count - 1
    name = Sheets(i).name
  
    ' Doi ten sheet voi so km format dang "000" va luu tên cu lai
    If name Like "KM*+*" Then
        k = k + 1
        arr(k, 1) = name
        arr(k, 2) = "KM" & Format(Mid(name, 3, InStr(3, name, "+") - 3), "000") & Mid(name, InStr(3, name, "+"), 255)
        Sheets(i).name = arr(k, 2)
    End If
Next

'Sap xep tang dan
For i = 1 To count - 1
        For j = i + 1 To count
        If Sheets(j).name < Sheets(i).name Then
            Sheets(j).Move before:=Sheets(i)
        End If
    Next j
Next i

'Tra lai ten cho em
For i = 1 To count
    For j = 1 To UBound(arr)
        If Sheets(i).name = arr(j, 2) Then Sheets(i).name = arr(j, 1)
    Next
Next
Application.ScreenUpdating = True
End Sub

Đúng là giải pháp excel đưa lên đây toàn gặp các cao thủ

 

[bebo021999]

Code này còn củ chuối hơn nhưng chạy được là được

Sub SortSheet()
    Sheet7.Range("AAA5").Resize(i, 2) = arr
    Sheet7.Range("AAA5").Resize(i, 2).Sort Key1:=Sheet7.Range("AAB5"), Order1:=xlAscending
    arr = Sheet7.Range("AAA5:AAB" & 4 + i).Value
    Sheet7.Range("AAA5").Resize(i, 2).ClearContents
End Sub

Mượn cột AAA5 nào đó của sheet nào đó thì phải thông báo cho chủ thớt nhé!
Biết là khó khi nào cột này dùng đến nhưng biết đâu đấy!
Sao không dùng XFD luôn?
Và trước khi dùng phải kiểm tra xem có dữ liệu trong cột đó không.