Nhờ viết code sắp xếp sheet! (1 người xem)

Liên hệ QC

Người dùng đang xem chủ đề này

Đang trực tuyến: 1 (Thành viên: 0, Khách: 1)
vova2209

vova2209

Thành viên tích cực
Tham gia
5/4/17
Bài viết
835
Được thích
112
Giới tính
Nam
Nghề nghiệp
Đường bộ
Em có 10 sheets("AA1") -:- sheets("AA10") và sheets("BB1") -:- sheets("BB10")
giờ em muốn code sắp xếp: AA1 > BB1 > AA2 >> BB2 >>... AAn >> BBn... em xin chân thành cảm ơn!
 
Sắp xếp theo thời gian sắp xếp theo bầu chọn
Mần thử xem đúng yêu cầu của bạn không nhé

Mã: 
Sub SortWorksheets()
    
    Dim N As Integer
    Dim m As Integer
    Dim FirstWSToSort As Integer
    Dim LastWSToSort As Integer
    Dim SortDescending As Boolean
    
    SortDescending = False
    
    If ActiveWindow.SelectedSheets.Count = 1 Then
        
         'Change the 1 to the worksheet you want sorted first
        FirstWSToSort = 1
        LastWSToSort = Worksheets.Count
    Else
        With ActiveWindow.SelectedSheets
            For N = 2 To .Count
                If .item(N - 1).index <> .item(N).index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next N
            FirstWSToSort = .item(1).index
            LastWSToSort = .item(.Count).index
        End With
    End If
    
    For m = FirstWSToSort To LastWSToSort
        For N = m To LastWSToSort
            If SortDescending = True Then
                If UCase(Worksheets(N).name) > UCase(Worksheets(m).name) Then
                    Worksheets(N).Move Before:=Worksheets(m)
                End If
            Else
                If UCase(Worksheets(N).name) < UCase(Worksheets(m).name) Then
                    Worksheets(N).Move Before:=Worksheets(m)
                End If
            End If
        Next N
    Next m
    
End Sub
 
Upvote 0
vova2209 đã viết:
Em có 10 sheets("AA1") -:- sheets("AA10") và sheets("BB1") -:- sheets("BB10")
giờ em muốn code sắp xếp: AA1 > BB1 > AA2 >> BB2 >>... AAn >> BBn... em xin chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Mã: 
Sub GPE()
Dim i As Long, tmp As String
For i = 1 To Sheets.Count
  tmp = "AA" & i
  If ExitSheet(tmp) Then
    k = k + 1
    Sheets(tmp).Move Before:=Worksheets(k)
  End If
  tmp = "BB" & i
  If ExitSheet(tmp) Then
    k = k + 1
    Sheets(tmp).Move Before:=Worksheets(k)
  End If
Next i
End Sub
Function ExitSheet(ByVal tmp As String) As Boolean
  Dim Test As Variant
  On Error Resume Next
  Test = Sheets(tmp).Range("A1").Value
  If Err.Number = 0 Then ExitSheet = True
End Function
 
Upvote 0
Thử dùng SortedList...
PHP: 
Sub vidu_SortedList()
    Const sMatch1 = "AA*"
    Const sMatch2 = "BB*"
    Dim oSList As Object, ws As Worksheet, N As Long
    Dim i As Long, idex1 As Long, idex2 As Long, sName As String
    Set oSList = CreateObject("System.Collections.SortedList")
    For Each ws In ThisWorkbook.Worksheets
        If (ws.Name Like sMatch1) Or (ws.Name Like sMatch2) Then
            oSList.Add ws.Name, ""
        End If
    Next ws
    N = oSList.Count
    If N = 0 Or N Mod 2 <> 0 Then Exit Sub
    If (oSList.GetKey(N / 2 - 1) Like sMatch1) And (oSList.GetKey(N / 2) Like sMatch2) Then
        idex2 = 1
        Sheets(oSList.GetKey(0)).Move Before:=Sheets(1)
        For i = 1 To N - 1
            If i < N / 2 Then
                idex1 = idex1 + 1
                sName = oSList.GetKey(i)
                Sheets(sName).Move After:=Sheets(idex1)
            Else
                sName = oSList.GetKey(i)
                Sheets(sName).Move After:=Sheets(idex2)
                idex2 = idex2 + 2
            End If
        Next i
    End If
End Sub
 
Lần chỉnh sửa cuối:
Upvote 0
quyenpv đã viết:
Mần thử xem đúng yêu cầu của bạn không nhé

Mã: 
Sub SortWorksheets()
   
    Dim N As Integer
    Dim m As Integer
    Dim FirstWSToSort As Integer
    Dim LastWSToSort As Integer
    Dim SortDescending As Boolean
   
    SortDescending = False
   
    If ActiveWindow.SelectedSheets.Count = 1 Then
       
         'Change the 1 to the worksheet you want sorted first
        FirstWSToSort = 1
        LastWSToSort = Worksheets.Count
    Else
        With ActiveWindow.SelectedSheets
            For N = 2 To .Count
                If .item(N - 1).index <> .item(N).index - 1 Then
                    MsgBox "You cannot sort non-adjacent sheets"
                    Exit Sub
                End If
            Next N
            FirstWSToSort = .item(1).index
            LastWSToSort = .item(.Count).index
        End With
    End If
   
    For m = FirstWSToSort To LastWSToSort
        For N = m To LastWSToSort
            If SortDescending = True Then
                If UCase(Worksheets(N).name) > UCase(Worksheets(m).name) Then
                    Worksheets(N).Move Before:=Worksheets(m)
                End If
            Else
                If UCase(Worksheets(N).name) < UCase(Worksheets(m).name) Then
                    Worksheets(N).Move Before:=Worksheets(m)
                End If
            End If
        Next N
    Next m
   
End Sub
Nhấp chuột vào đây để mở rộng...
Không đúng như mong muốn anh ạ! nó vẫn theo thứ tự từng loại
 
Upvote 0
HieuCD đã viết:
Mã: 
Sub GPE()
Dim i As Long, tmp As String
For i = 1 To Sheets.Count
  tmp = "AA" & i
  If ExitSheet(tmp) Then
    k = k + 1
    Sheets(tmp).Move Before:=Worksheets(k)
  End If
  tmp = "BB" & i
  If ExitSheet(tmp) Then
    k = k + 1
    Sheets(tmp).Move Before:=Worksheets(k)
  End If
Next i
End Sub
Function ExitSheet(ByVal tmp As String) As Boolean
  Dim Test As Variant
  On Error Resume Next
  Test = Sheets(tmp).Range("A1").Value
  If Err.Number = 0 Then ExitSheet = True
End Function
Nhấp chuột vào đây để mở rộng...
code này chạy cũng không như mong muốn anh à! code này chạy giống bài #2
em muốn Sheets("AA1"),Sheets("BB1"),Sheets("AA2"),Sheets("BB2") ==== chứ không phải là Sheets("AA1"),Sheets("AA2")....,Sheets("BB1"),Sheets("BB2")....
 
Lần chỉnh sửa cuối:
Upvote 0
befaint đã viết:
Thử dùng SortedList...
PHP: 
Sub vidu_SortedList()
    Const sMatch1 = "AA*"
    Const sMatch2 = "BB*"
    Dim oSList As Object, ws As Worksheet, N As Long
    Dim i As Long, idex1 As Long, idex2 As Long, sName As String
    Set oSList = CreateObject("System.Collections.SortedList")
    For Each ws In ThisWorkbook.Worksheets
        If (ws.Name Like sMatch1) Or (ws.Name Like sMatch2) Then
            oSList.Add ws.Name, ""
        End If
    Next ws
    N = oSList.Count
    If N = 0 Or N Mod 2 <> 0 Then Exit Sub
    If (oSList.GetKey(N / 2 - 1) Like sMatch1) And (oSList.GetKey(N / 2) Like sMatch2) Then
        idex2 = 1
        Sheets(oSList.GetKey(0)).Move Before:=Sheets(1)
        For i = 1 To N - 1
            If i < N / 2 Then
                idex1 = idex1 + 1
                sName = oSList.GetKey(i)
                Sheets(sName).Move After:=Sheets(idex1)
            Else
                sName = oSList.GetKey(i)
                Sheets(sName).Move After:=Sheets(idex2)
                idex2 = idex2 + 2
            End If
        Next i
    End If
End Sub
Nhấp chuột vào đây để mở rộng...
Code ko chạy được tý nào ạ! em up file lên giúp em với!
 

File đính kèm

Upvote 0
befaint đã viết:
Bạn vui tính nhỉ? "Treo đầu dê bán thịt..."

"10 sheets("AA1") -:- sheets("AA10") và sheets("BB1") -:- sheets("BB10")"

View attachment 183826

-----------
Bài #4 là chuẩn rồi bạn.
Nhấp chuột vào đây để mở rộng...
Số sheet ban có ban đầu! Em có 10 sheets("AA1") -:- sheets("AA10") và sheets("BB1") -:- sheets("BB10")
em muốn nó xếp như này ạ! "sắp xếp: AA1 > BB1 > AA2 >> BB2 >>... AAn >> BBn"
 
Upvote 0
vova2209 đã viết:
Số sheet ban có ban đầu! Em có 10 sheets("AA1") -:- sheets("AA10") và sheets("BB1") -:- sheets("BB10")
em muốn nó xếp như này ạ! "sắp xếp: AA1 > BB1 > AA2 >> BB2 >>... AAn >> BBn"
Nhấp chuột vào đây để mở rộng...
Bạn ơi. Bạn có biết thế nào tên sheet không?
Bài #1 bài yêu cầu tên các sheets là "AA1",... "BB1"... trong khi file bạn vừa đưa không có cái sheet nào tên như thế. Đã trích dẫn và đính kèm hình chụp gần nhau thế cho bạn nhìn rồi!

Đây gọi là sheet "AA1",... "BB1"...
upload_2017-9-28_0-38-44.png


Bạn đổi lại điều kiện nhận biết tên sheet của bạn trong code trên là được. Mình động não chút chứ!!!

Có 20 cái sheets dùng tay kéo cho dẻo!
 
Upvote 0
befaint đã viết:
Bạn ơi. Bạn có biết thế nào tên sheet không?
Bài #1 bài yêu cầu tên các sheets là "AA1",... "BB1"... trong khi file bạn vừa đưa không có cái sheet nào tên như thế. Đã trích dẫn và đính kèm hình chụp gần nhau thế cho bạn nhìn rồi!

Đây gọi là sheet "AA1",... "BB1"...
View attachment 183827


Bạn đổi lại điều kiện nhận biết tên sheet của bạn trong code trên là được. Mình động não chút chứ!!!

Có 20 cái sheets dùng tay kéo cho dẻo!
Nhấp chuột vào đây để mở rộng...
Sub GPE()
Dim i As Long, tmp As String
For i = 1 To Sheets.Count
tmp = "CD-L" & i
If ExitSheet(tmp) Then
k = k + 1
Sheets(tmp).Move Before:=Worksheets(k)
End If
tmp = "DT-L" & i
If ExitSheet(tmp) Then
k = k + 1
Sheets(tmp).Move Before:=Worksheets(k)
End If
Next i
End Sub
Function ExitSheet(ByVal tmp As String) As Boolean
Dim Test As Variant
On Error Resume Next
Test = Sheets(tmp).Range("A1").Value
If Err.Number = 0 Then ExitSheet = True
End Function
Nhấp chuột vào đây để mở rộng...
-------------------------------------------
Em Đổi như này rồi mà anh có phải giữ nguyên AA BB đâu, gửi cả file rồi mà bác
Bác mắng em nặng lời quá, nhưng ko sao bác giúp em nốt đi
Vì là code nó chưa chạy xếp 2 loại xen kẽ nhau ạ!
 
Upvote 0
befaint đã viết:
Bạn ơi. Bạn có biết thế nào tên sheet không?
Bài #1 bài yêu cầu tên các sheets là "AA1",... "BB1"... trong khi file bạn vừa đưa không có cái sheet nào tên như thế. Đã trích dẫn và đính kèm hình chụp gần nhau thế cho bạn nhìn rồi!

Đây gọi là sheet "AA1",... "BB1"...
Nhấp chuột vào đây để mở rộng...

View attachment 183827

Untitled.png
ý em muốn Môn na chạy ra như này anh à
 
Upvote 0
vova2209 đã viết:
Em có 10 sheets("AA1") -:- sheets("AA10") và sheets("BB1") -:- sheets("BB10")
giờ em muốn code sắp xếp: AA1 > BB1 > AA2 >> BB2 >>... AAn >> BBn... em xin chân thành cảm ơn!
Nhấp chuột vào đây để mở rộng...
Hãy dùng cách đơn giản nhất đi bạn. Mục đích là để tìm đến sheet cần tìm một cách nhanh nhất đúng không.
Hãy tạo một sheet Menu, rồi tạo các hyperlink để di chuyển đến sheet muốn chọn.
 
Upvote 0
Đơn giản nhất là bài này tháng trước đã có bài giải rồi. Chủ thớt lừoi biếng tìm.
 
Upvote 0
quanghai1969 đã viết:
Hãy dùng cách đơn giản nhất đi bạn. Mục đích là để tìm đến sheet cần tìm một cách nhanh nhất đúng không.
Hãy tạo một sheet Menu, rồi tạo các hyperlink để di chuyển đến sheet muốn chọn.
Nhấp chuột vào đây để mở rộng...
mục đích của em là để in 1 loạt theo thứ tự mình mong muốn ko phải xếp tay!. các anh cho code ok rồi ạ
 
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

N
  • Question Question
Nhờ mọi người góp ý cho file Quản lý bán hàng viết bằng VBA đầu tay của mình (9 người xem)
    • Cảm ơn
Trả lời
6
Đọc
72
VetMini
V
S
NHỜ ANH EM GIÚP MÌNH TÌM KIẾM DỮ LIỆU (4 người xem)
Trả lời
1
Đọc
5
snow25
snow25
ongke0711
  • Question Question
Tải hóa đơn điện tử (https://hoadondientu.gdt.gov.vn/) Excel Vba
    • Thích
    • Yêu thích
    • Cảm ơn
15 16 17
Trả lời
326
Đọc
24K
pycckuu410
P
HeSanbi
  • Question Question
Sự khác nhau giữa book.Worksheets và book.Sheets trong Application (3 người xem)
    • Thích
Trả lời
1
Đọc
84
VetMini
V
V
  • Question Question
Đếm xếp loại của đơn hàng (2 người xem)
Trả lời
8
Đọc
164
vanlinh_2904
V
J
Công thức tính lương khi mỗi tháng tăng lương cơ bản
Trả lời
2
Đọc
64
jangne88
J
H
Xin được trợ giúp lỗi máy không mở được cửa sổ VBE.
Trả lời
0
Đọc
27
HUONGHCKT
H
phatnguyen7301
  • Question Question
Viết code không trùng dữ liệu
Trả lời
3
Đọc
99
VetMini
V
HeSanbi
  • Question Question
GPEStudio - Ứng dụng hỗ trợ tương tác giữa Excel và diễn đàn GPE (1 người xem)
    • Thích
Trả lời
0
Đọc
76
HeSanbi
HeSanbi
yeudoi
Cà phê giao lưu cùng thành viên kỳ cựu Cao Mạnh Sơn 19h 23/2/2025
    • Thích
Trả lời
0
Đọc
39
yeudoi
yeudoi
HeSanbi
  • Question Question
FlashSheet v1.1 - Di chuyển qua lại tức thời giữa các trang tính (1 người xem)
    • Thích
    • Yêu thích
Trả lời
3
Đọc
595
HeSanbi
HeSanbi
Việt Nguyễn 86
Excel hay bị tắt đột ngột và hiện trang trắng khi làm việc
Trả lời
6
Đọc
223
HeSanbi
HeSanbi
Manhhung90
Thoát chế độ Read only file word. Nhờ mọi người giúp ạ
Trả lời
5
Đọc
91
Manhhung90
Manhhung90
H
chuyển dữ liệu từ 1 dòng thành nhiều dòng theo điều kiện cho trước.
Trả lời
3
Đọc
97
hanhnguyen12022021
H
N
Không chạy được file VBA
Trả lời
2
Đọc
99
hoangtuan.net
hoangtuan.net
H
Quản Lý Công Văn đi Và đến
9 10 11
Trả lời
214
Đọc
159K
ptm0412
ptm0412
T
Em muốn xin chỉ giáo file excel theo dõi thu chi, lãi lỗ của từng xe để báo cáo ạ
Trả lời
3
Đọc
101
VetMini
V
S
RemoveDuplicates Adodb VBA (1 người xem)
Trả lời
0
Đọc
76
sykika
S
G
  • Question Question
BẢO MẬT VBAPROJECT (1 người xem)
Trả lời
0
Đọc
133
giaoluu1231
G
sangvanng92
  • Question Question
Phân quyền user truy cập
Trả lời
9
Đọc
196
Hoàng Tuấn 868
H
Xem thêm…

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

Đếm ngược thời gian

000
Ngày
00
Giờ
00
phút
00
giây
TALKSHOW KHÁM PHÁ SỨC MẠNH HÀM FILTER TRONG EXCEL 365
Back
Top Bottom