Sắp xếp các Sheet - Bài toán sắp xếp

[Nguyễn Duy Tuân]

Gửi các bạn phương pháp sắp xếp các Sheet trong Workbook theo thứ tự nào đó.

 

[vova2209]

Vẫn chưa hình dung ra được sẽ sắp xếp thế nào! Bạn cho 1 ví dụ xem

Em có vài sheets vị trí lộn sộn: nhìn sheet ở bảng tính

 

[vova2209]

Vẫn chưa hình dung ra được sẽ sắp xếp thế nào! Bạn cho 1 ví dụ xem

+ CodeName có thứ tự tăng dần sheet1-sheet9 ko thể dịch chuyển trừ sửa tên CodeName
Như vậy nhìn ở bảng tính vị trí sheet mình kéo tay dịch chuyển đến vị khác để bấm cho gần. Kéo đi kéo lại sheet chạy linh tinh. Giờ e muốn code chạy các sheet xắp xếp về vị trí đầu theo thứ tự CodeName. Giúp e voéi ạ

 

[huonglien1901]

+ CodeName có thứ tự tăng dần sheet1-sheet9 ko thể dịch chuyển trừ sửa tên CodeName
Như vậy nhìn ở bảng tính vị trí sheet mình kéo tay dịch chuyển đến vị khác để bấm cho gần. Kéo đi kéo lại sheet chạy linh tinh. Giờ e muốn code chạy các sheet xắp xếp về vị trí đầu theo thứ tự CodeName. Giúp e voéi ạ

bạn dùng code này thử:

Sub Sort_sheet()
Dim xResult As VbMsgBoxResult
xResult = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, xTitleId)
For i = 1 To Application.Sheets.Count
    For j = 1 To Application.Sheets.Count - 1
        If xResult = vbYes Then
            If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
                Sheets(j).Move after:=Sheets(j + 1)
            End If
            ElseIf xResult = vbNo Then
                If UCase$(Application.Sheets(j).Name) < UCase$(Application.Sheets(j + 1).Name) Then
                    Application.Sheets(j).Move after:=Application.Sheets(j + 1)
            End If
        End If
    Next
Next
End Sub

 

[vova2209]

bạn dùng code này thử:

Sub Sort_sheet()
Dim xResult As VbMsgBoxResult
xResult = MsgBox("Sort Sheets in Ascending Order?" & Chr(10) & "Clicking No will sort in Descending Order", vbYesNoCancel + vbQuestion + vbDefaultButton1, xTitleId)
For i = 1 To Application.Sheets.Count
    For j = 1 To Application.Sheets.Count - 1
        If xResult = vbYes Then
            If UCase$(Application.Sheets(j).Name) > UCase$(Application.Sheets(j + 1).Name) Then
                Sheets(j).Move after:=Sheets(j + 1)
            End If
            ElseIf xResult = vbNo Then
                If UCase$(Application.Sheets(j).Name) < UCase$(Application.Sheets(j + 1).Name) Then
                    Application.Sheets(j).Move after:=Application.Sheets(j + 1)
            End If
        End If
    Next
Next
End Sub

chưa đúng ý em rồi. Kết quả trả về bài #81 như hình 2 ạ. anh chị xem lại hộ em

 

[huonglien1901]

chưa đúng ý em rồi. Kết quả trả về bài #81 như hình 2 ạ. anh chị xem lại hộ em

Bạn thử chưa vậy? Bạn có thể gửi cái file mẫu lên đây được không?
Code này sắp xếp tăng dần và giảm dần mà.
Nếu bạn chọn yes: là tăng dần
Nếu bạn chọn no: là giảm dần

 

[Hau151978]

Bạn thử chưa vậy? Bạn có thể gửi cái file mẫu lên đây được không?
Code này sắp xếp tăng dần và giảm dần mà.
Nếu bạn chọn yes: là tăng dần
Nếu bạn chọn no: là giảm dần

Code của bạn sort theo name, chủ topic cần sort theo codename mà.

 

[huonglien1901]

Code của bạn sort theo name, chủ topic cần sort theo codename mà.

Anh thử code này thử:

Sub SortSheetsCodeName()
Application.ScreenUpdating = False
Dim iSheets%, i%, j%, ws As Worksheet
iSheets = Sheets.Count
    For Each ws In Worksheets
If Len(ws.CodeName) = 6 Then
For i = 1 To iSheets - 1
    For j = i + 1 To iSheets
If Val(Right(Sheets(j).CodeName, 1)) < Val(Right(Sheets(i).CodeName, 1)) _
Then Sheets(j).Move before:=Sheets(i)
    Next j
Next i
End If
    Next ws
For Each ws In Worksheets
If Len(ws.CodeName) > 6 Then
For i = 1 To iSheets - 1
For j = i + 1 To iSheets
If Val(Right(Sheets(j).CodeName, 2)) < Val(Right(Sheets(i).CodeName, 2)) _
Then Sheets(j).Move before:=Sheets(i)
Next j
Next i
End If
Next ws
Application.ScreenUpdating = True
End Sub

 

[vova2209]

Anh thử code này thử:

Sub SortSheetsCodeName()
Application.ScreenUpdating = False
Dim iSheets%, i%, j%, ws As Worksheet
iSheets = Sheets.Count
    For Each ws In Worksheets
If Len(ws.CodeName) = 6 Then
For i = 1 To iSheets - 1
    For j = i + 1 To iSheets
If Val(Right(Sheets(j).CodeName, 1)) < Val(Right(Sheets(i).CodeName, 1)) _
Then Sheets(j).Move before:=Sheets(i)
    Next j
Next i
End If
    Next ws
For Each ws In Worksheets
If Len(ws.CodeName) > 6 Then
For i = 1 To iSheets - 1
For j = i + 1 To iSheets
If Val(Right(Sheets(j).CodeName, 2)) < Val(Right(Sheets(i).CodeName, 2)) _
Then Sheets(j).Move before:=Sheets(i)
Next j
Next i
End If
Next ws
Application.ScreenUpdating = True
End Sub

Chuẩn chuẩn rồi! mình xin chân thành cảm ơn nhiều..

 

[vova2209]

Code của bạn sort theo name, chủ topic cần sort theo codename mà.

Cảm ơn bạn! Mình diễn tả hết cách rồi may quá có bạn. Xin cảm ơn sự giúp đỡ

 

[VetMini]

@ tác giả bài #87 và #83:
Codename của sheet, trừ phi bị cố tình đổi tên, thì có dạng là "Sheet" & n, n là số nguyên.
Theo nguyên tắc, số nguyên thì có thể dùng kỹ thuật chỉ số mảng để sort

Dim Sh As Variant
Dim mang(1 to 5000) As String
Dim nMin As Integer, nMax As Integer, n As Integer
nMin = 5000: nMax = 1
For each sh in Worksheets
n = Val(Replace(sh.Codename, "Sheet", ""))
mang(n) = sh.Name
If n > nMax Then nMax = n ' tìm chỉ số đầu và chỉ số cuối của mảng
If n < nMin Then nMin = 1
Next sh
' đến đây thì bạn đã có 1 mảng tên sheet, sắp xếp theo codename
Din curSh As WorkSheet ' đặt một cái mốc
Dim stp As Integer
If sortThuanChieu Then
stp = 1
Else ' nếu sort ngược chiều, hoán vị max-min và đổi dấu step
stp = nMax
nMax = nMin
nMin = stp
stp = -1
End If
Set curSh = Sheets(1)
For n = nMin To nMax Step stp
If mang(n) <> "" Then
Sheets(mang(n)).Move After:=curSh
Set curSh = Sheets(mang(n))
End If
Next n

Đại khái thuật toán là vậy. Bạn có thể cần điều chỉnh những chỗ chi tiết.

 

[huonglien1901]

@ tác giả bài #87 và #83:
Codename của sheet, trừ phi bị cố tình đổi tên, thì có dạng là "Sheet" & n, n là số nguyên.
Theo nguyên tắc, số nguyên thì có thể dùng kỹ thuật chỉ số mảng để sort

Dim Sh As Variant
Dim mang(1 to 5000) As String
Dim nMin As Integer, nMax As Integer, n As Integer
nMin = 5000: nMax = 1
For each sh in Worksheets
n = Val(Replace(sh.Codename, "Sheet", ""))
mang(n) = sh.Name
If n > nMax Then nMax = n ' tìm chỉ số đầu và chỉ số cuối của mảng
If n < nMin Then nMin = 1
Next sh
' đến đây thì bạn đã có 1 mảng tên sheet, sắp xếp theo codename
Din curSh As WorkSheet ' đặt một cái mốc
Dim stp As Integer
If sortThuanChieu Then
stp = 1
Else ' nếu sort ngược chiều, hoán vị max-min và đổi dấu step
stp = nMax
nMax = nMin
nMin = stp
stp = -1
End If
Set curSh = Sheets(1)
For n = nMin To nMax Step stp
If mang(n) <> "" Then
Sheets(mang(n)).Move After:=curSh
Set curSh = Sheets(mang(n))
End If
Next n

Đại khái thuật toán là vậy. Bạn có thể cần điều chỉnh những chỗ chi tiết.

Em cảm ơn Anh, giải thuật của Anh rất hay. Em sẽ copy về để học.

 

[Hau151978]

@VetMini hình như chỗ
if n<nMin then nMin=1
là
if n<nMin then nMin=n bác nhỉ

 

[VetMini]

@VetMini hình như chỗ
if n<nMin then nMin=1
là
if n<nMin then nMin=n bác nhỉ

Ờ viết vội cho nên nhầm.

 

[dactuan97]

Thật ra cũng đã làm rồi, em đưa lên cho anh tham khảo ---> Với file đính kèm dưới đây anh có thể sort bất kỳ nhóm sheet nào anh muốn
- Mở file lên và bấm Ctrl + Shift + S để gọi form
- Một form hiện ra như hình:

View attachment 46070


- Dùng chuột chọn 1 sheet trong ListBox rồi bấm giữ Ctrl và chọn thêm sheet khác... Cũng có thể chọn sheet đầu, giữ phím Shift và chọn sheet cuối (nếu các sheet nằm liên tục nhau)
- Tiếp theo chọn kiểu sort tăng dần hay giảm dần bằng cách check vào Option Button
- Cuối cùng là bấm nút Sort
- Code này có thể lưu lại thành 1 Add-In để dùng lâu dài
(code của em cũng chưa tối ưu lắm... để từ từ cải tiến thêm)

Em có 1 file excel hơn 100 sheet, em đã tải file của anh về và chạy thì không sắp xếp theo thứ tự tăng dần được, mong anh chỉ em cách khắc phục ạ!

 

[Phuocam]

Em có 1 file excel hơn 100 sheet, em đã tải file của anh về và chạy thì không sắp xếp theo thứ tự tăng dần được, mong anh chỉ em cách khắc phục ạ!

Bạn đặt tên sheet có 3 ký tự như 001, 002, 003, ...,100,101 sẽ sắp xếp được.

.

 

[dactuan97]

Bạn đặt tên sheet có 3 ký tự như 001, 002, 003, ...,100,101 sẽ sắp xếp được.

.

Good idea,
Em cảm ơn ạ!