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

Liên hệ QC
Nguyễn Duy Tuân

Nguyễn Duy Tuân

Nghị Hách
Thành viên danh dự
Tham gia
13/6/06
Bài viết
4,649
Được thích
10,138
Giới tính
Nam
Nghề nghiệp
Giáo viên, CEO tại Bluesofts
Gửi các bạn phương pháp sắp xếp các Sheet trong Workbook theo thứ tự nào đó.
 

File đính kèm

  • Sapxep.zip
    14.8 KB · Đọc: 2,752
Sắp xếp theo thời gian sắp xếp theo bầu chọn
ndu96081631 đã viết:
Vẫn chưa hình dung ra được sẽ sắp xếp thế nào! Bạn cho 1 ví dụ xem
Nhấp chuột vào đây để mở rộng...
+ 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 ạ
 
Upvote 0
vova2209 đã viết:
+ 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 ạ
Nhấp chuột vào đây để mở rộng...
bạn dùng code này thử:
PHP: 
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
 
Upvote 0
huonglien1901 đã viết:
bạn dùng code này thử:
PHP: 
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
vova2209 đã viết:
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
Nhấp chuột vào đây để mở rộng...
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
 
Upvote 0
huonglien1901 đã viết:
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
Nhấp chuột vào đây để mở rộng...
Code của bạn sort theo name, chủ topic cần sort theo codename mà.
 
Upvote 0
Hau151978 đã viết:
Code của bạn sort theo name, chủ topic cần sort theo codename mà.
Nhấp chuột vào đây để mở rộng...
Anh thử code này thử:
PHP: 
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
 
Upvote 0
huonglien1901 đã viết:
Anh thử code này thử:
PHP: 
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
Nhấp chuột vào đây để mở rộng...
Chuẩn chuẩn rồi! mình xin chân thành cảm ơn nhiều..
 
Upvote 0
@ 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.
 
Upvote 0
VetMini đã viết:
@ 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.
Nhấp chuột vào đây để mở rộng...
Em cảm ơn Anh, giải thuật của Anh rất hay. Em sẽ copy về để học.
 
Upvote 0
ndu96081631 đã viết:
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)
Nhấp chuột vào đây để mở rộng...
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 ạ!
 

File đính kèm

  • 1.png
    1.png
    15.8 KB · Đọc: 5
Upvote 0
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

Bài viết mới nhất

A
Đếm dữ liệu với điều kiện
Trả lời
9
Đọc
45
DeTong
D
Maika8008
  • Question
Add-In .xlam trộn dữ liệu Excel vào Word
    • Thích
    • Yêu thích
    • Cảm ơn
2
Trả lời
28
Đọc
2K
DeTong
D
T
V/v tối ưu xử lý đoạn code
Trả lời
4
Đọc
128
huhumalu
H
H
  • Question
nhờ các bác viết mẫu cho em lệnh dùng checkbox để rút ngắn thời gian thao tác
Trả lời
16
Đọc
372
giaiphap
giaiphap
H
Xin giúp đỡ lấy lại file excel bị lưu đè
Trả lời
5
Đọc
112
befaint
befaint
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom