- Tham gia
- 13/6/06
- Bài viết
- 4,845
- Được thích
- 10,338
- Giới tính
- Nam
- Nghề nghiệp
- Giáo viên, CEO tại Bluesofts
Mình sắp xếp tên theo vần A,B, C, nhưng các cột còn lại không đổi theo, tôi có làm thiếu bước nào không nhỉ ??
Thử file này xem:Em đã tải về và sắp xếp, nhưng chỉ xếp đợc theo thứ tự giảm dần chứ không xếp được theo thứ tự tăng dần. làm thế nào để xếp được theo thứ tự tăng dần ạ?
Sub SortSheet(Order As Boolean)
Dim i As Long, j As Long
Application.ScreenUpdating = False
For i = 1 To Sheets.Count - 1
For j = i + 1 To Sheets.Count
If Sheets(IIf(Order, j, i)).Name < Sheets(IIf(Order, i, j)).Name Then
Sheets(j).Move Before:=Sheets(i)
End If
Next j
Next i
Application.ScreenUpdating = True
End Sub
Sub Main()
Dim TB As Long
TB = MsgBox("Ban muon sort tang hay giam dan?" & vbLf & _
"Bam 'YES' de sort tang dan" & vbLf & _
"Bam 'NO' de sort giam dan", 4)
SortSheet (TB = 6)
End Sub
---Thử file này xem:
PHP:Sub SortSheet(Order As Boolean) Dim i As Long, j As Long Application.ScreenUpdating = False For i = 1 To Sheets.Count - 1 For j = i + 1 To Sheets.Count If Sheets(IIf(Order, j, i)).Name < Sheets(IIf(Order, i, j)).Name Then Sheets(j).Move Before:=Sheets(i) End If Next j Next i Application.ScreenUpdating = True End Sub
PHP:Sub Main() Dim TB As Long TB = MsgBox("Ban muon sort tang hay giam dan?" & vbLf & _ "Bam 'YES' de sort tang dan" & vbLf & _ "Bam 'NO' de sort giam dan", 4) SortSheet (TB = 6) End Sub
Anh để ý code của em có đoạn:---
Anh có 1 file có khoảng 70 sheet, 10 sheet đầu tiên được sắp xếp theo trình tự nhập liệu, do không muốn người xử dụng thay đổi vị trí các sheet này ( 10 sheet đầu tiên ) , không biết chú có thể viết giúp code này được không ? 60 sheet còn lại được sắp xếp thứ tự tăng dần hay giảm dần đều được. Mong chú rõ, Cám ơn.
---Anh để ý code của em có đoạn:
For i = 1 To Sheets.Count - 1
Tức sort từ sheet đầu tiên... trong khi anh lại muốn sort từ sheet thứ 11 trở đi ---> Vậy cách đơn giản là sửa code trên thành:
For i = 11 To Sheets.Count - 1
Muốn tổng quát hơn, tức có thể sort bất kỳ nhóm sheet nào thì phải sửa code lại khá nhiều
10 sheet đầu tiên được sắp xếp theo trình tự nhập liệu, do không muốn người xử dụng thay đổi vị trí các sheet này ( 10 sheet đầu tiên )
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---
Cám ơn chú, vậy là giải quyết được vấn đề sắp xếp từ sheet thứ 11 trở đi. Nếu chú thấy khả thi thì còn việc cố định 10 sheet đầu có gặp trở ngại không ?
NDU viết giúp code sort sheets thêm phần theo màu tô. (tab color).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)
Ý ThuNghi là sao? Là sort theo màu sắc hay chỉ thêm phần tô màu khi sort?NDU viết giúp code sort sheets thêm phần theo màu tô. (tab color).
Vd: theo thứ tự Xanh, đỏ, vàng...
Dùng cả cho Ex 03 và 07.
Cám ơn.
Sort theo màu sắc, màu đã tô cho sh.Ý ThuNghi là sao? Là sort theo màu sắc hay chỉ thêm phần tô màu khi sort?
- Nếu là sort theo màu sắc thì phải viết lại toàn bộ code
- Nếu chỉ là thêm màu sắc trong khi sort thì dễ mà ---> thêm vào code Sheets(...).Tab.ColorIndex = ???
Hi Anh Duy Tuân . Anh ơi , em đã tải file sắp xếp của anh về nhưng bây giờ phải làm sao để sắp xếp các sheet được ạ. Mong anh giúp em với, vì em không rành mấy vụ này lắm.
Em cảm ơn anh nhiều.
Hi anh Nguyễn Duy Tuân, em muốn sắp xếp vị trí các sheet theo một thứ tự cho trước chứ không theo thứ tự 123... hay abc... ạ. Trong file em gửi kèm, tên các sheet ở cột A, thứ tự cần sắp xếp theo cột B. Anh làm giúp em với. Cảm ơn anh nhiều!!!
Bạn có thể dùng macro sau.Hi anh Nguyễn Duy Tuân, em muốn sắp xếp vị trí các sheet theo một thứ tự cho trước chứ không theo thứ tự 123... hay abc... ạ. Trong file em gửi kèm, tên các sheet ở cột A, thứ tự cần sắp xếp theo cột B. Anh làm giúp em với. Cảm ơn anh nhiều!!!
Sub SortShs()
Dim ArrIndex As Variant, i As Long
ArrIndex = Sheets("Index").Range("A2:B6").Value
SortArr ArrIndex
Application.ScreenUpdating = False
For i = 1 To UBound(ArrIndex, 1)
Sheets(ArrIndex(i, 1)).Move Before:=Sheets(1)
Next
Sheets("Index").Move Before:=Sheets(1) 'Xoa dong nay neu muon sheet Index nam o cuoi cung'
Sheets("Index").Select
Application.ScreenUpdating = True
End Sub
Private Function SortArr(ByRef Arr As Variant) As Variant
Dim i As Long, j As Long, TmpVal As Variant
For i = 1 To UBound(Arr, 1) - 1
For j = i + 1 To UBound(Arr, 1)
If Arr(j, 2) > Arr(i, 2) Then
TmpVal = Arr(i, 1): Arr(i, 1) = Arr(j, 1): Arr(j, 1) = TmpVal
TmpVal = Arr(i, 2): Arr(i, 2) = Arr(j, 2): Arr(j, 2) = TmpVal
End If
Next
Next
End Function
Cho bạn thêm cách:Hi anh Nguyễn Duy Tuân, em muốn sắp xếp vị trí các sheet theo một thứ tự cho trước chứ không theo thứ tự 123... hay abc... ạ. Trong file em gửi kèm, tên các sheet ở cột A, thứ tự cần sắp xếp theo cột B. Anh làm giúp em với. Cảm ơn anh nhiều!!!
Sub move()
Dim arr1, num1 As Long
arr1 = Sheets("index").[A2:B6]
For num1 = 1 To UBound(arr1)
Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2))
Next num1
Sheets("index").Select
End Sub
Thứ tự hiện tại là S1, S2, S3 tôi muốn xếp lại là S3, S1, S2 nhưng không đúngCho bạn thêm cách:
PHP:Sub move() Dim arr1, num1 As Long arr1 = Sheets("index").[A2:B6] For num1 = 1 To UBound(arr1) Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2)) Next num1 Sheets("index").Select End Sub
có trường hợp bị sai sheet đầu cần bẩy sheet đầuEm chưa hiểu ý anh ta, em sếp thấy vẫn đúng !!!
ten sheet thứ tự
sheet1 2
sheet2 3
sheet3 1
Sub move()
Dim arr1, num1 As Long
arr1 = Sheets("index").[A2:C6]
For num1 = 1 To UBound(arr1)
If arr1(num1, 2) = 1 Then
Sheets(arr1(num1, 1)).move before:=Sheets(1)
Else
Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2))
End If
Next num1
Sheets("index").Select
End Sub
Code này hơi chủ quan! Vì làm sao bạn chắc ăn sheets(arr1(num1, 1)) thật sự tồn tại? Bạn không nghĩ rằng có thể người dùng gõ sai sao?Cho bạn thêm cách:
PHP:Sub move() Dim arr1, num1 As Long arr1 = Sheets("index").[A2:B6] For num1 = 1 To UBound(arr1) Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2)) Next num1 Sheets("index").Select End Sub
Thứ tự hiện tại là S1, S2, S3 tôi muốn xếp lại là S3, S1, S2 nhưng không đúng![]()
Em nghĩ sữa lại vầy là được:có trường hợp bị sai sheet đầu cần bẩy sheet đầuMã:Sub move() Dim arr1, num1 As Long arr1 = Sheets("index").[A2:C6] For num1 = 1 To UBound(arr1) If arr1(num1, 2) = 1 Then Sheets(arr1(num1, 1)).move before:=Sheets(1) Else Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2)) End If Next num1 Sheets("index").Select End Sub
Sub move()
Dim arr1, num1 As Long
arr1 = Sheets("index").[A2:B6]
For num2 = 1 To 2
For num1 = 1 To UBound(arr1)
Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2))
Next num1
Next num2
Sheets("index").Select
End Sub
Vâng, em viết theo file thôi anh ạ, không để ý tới nếu viết sai , chắc thêm on error nữa là được phải không anh!!Code này hơi chủ quan! Vì làm sao bạn chắc ăn sheets(arr1(num1, 1)) thật sự tồn tại? Bạn không nghĩ rằng có thể người dùng gõ sai sao?
Nếu bạn viết code cho chính bạn thì không vấn đề gì rồi (bạn thừa sức sửa nếu có sai sót) nhưng ở đây là người khác dùng, có thể họ chưa biết gì về vba luôn... Vậy ta càng cẩn thận càng tốt
...không để ý tới nếu viết sai , chắc thêm on error nữa là được phải không anh!!
Vậy bạn cũng đâu biết thật sự điều gì đang diễn ra! Sao bạn không viết thêm 1 hàm kiểm tra sự tồn tại của tên sheet có phải êm chuyện không?Vâng, em viết theo file thôi anh ạ, không để ý tới nếu viết sai , chắc thêm on error nữa là được phải không anh!!
Vâng , như anh nói dùng On error .. thì đúng là không biết có lỗi hay không hay là lỗi ở đâu, có lẽ là biết lỗi chỗ nào thì khắc phục chỗ đấy sẽ ổn hơn!!!On error là loại giải pháp nguy hiểm. Nó cho phép bạn lướt qua lỗi. Nhưng có chắc là ngừoi dùng muốn lướt qua lỗi hay không?
Tuỳ theo điều kiện yêu cầu.
Nếu yêu cầu "làm được mức nào hay mức đó" thì On Error sử dụng được.
Nếu yêu cầu "nếu không được cả thì để yên như cũ" thì On Error không thể sử dụng được.
Ví dụ tôi có một vài tên gõ sai. Và sau đó tôi chạy một cái sub dựa vào vị trí của sheets để làm việc thì kết quả của tôi sẽ sai bấy hết.
Trường hợp sheets(arr1(num1, 1)) thì em có thể dùng vòng lặp để xét cái arr1(num1, 1) có tồn tại trong các sheets.name của workbook hay không, nhưng trường hợp Sheets(arr1(num1, 2)) (với arr1(num1, 2) là number) thì em chưa nghĩ ra cách để bẫy lỗi trường hợp này anh ạ, anh có thể cho em một đoạn code kiểm tra trường hợp này được không ạ!!!Vậy bạn cũng đâu biết thật sự điều gì đang diễn ra! Sao bạn không viết thêm 1 hàm kiểm tra sự tồn tại của tên sheet có phải êm chuyện không?
Hễ nhìn thấy lỗi thì phải bẫy cho bằng được! On Errorr... chỉ nên là biện pháp cuối cùng để phòng những tình huống ta chưa nghĩ ra hoặc cho 1 lỗi nào đó mà ta không tài nào bẫy được bằng cách khác
Thêm 1 vòng lập For num2 = 1 To 2, mặc dù giải quyết được vấn đề, nhưng làm cho thuật toán trở nên khó hiểu, có vẽ ăn may chứ không dựa trên cơ sở phân tích tình huống và đưa ra giải thuật phù hợpChưa
Em nghĩ sữa lại vầy là được:
PHP:Sub move() Dim arr1, num1 As Long arr1 = Sheets("index").[A2:B6] For num2 = 1 To 2 For num1 = 1 To UBound(arr1) Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2)) Next num1 Next num2 Sheets("index").Select End Sub
Vâng, em viết theo file thôi anh ạ, không để ý tới nếu viết sai , chắc thêm on error nữa là được phải không anh!!
số sheet = Sheets.CountTrường hợp sheets(arr1(num1, 1)) thì em có thể dùng vòng lặp để xét cái arr1(num1, 1) có tồn tại trong các sheets.name của workbook hay không, nhưng trường hợp Sheets(arr1(num1, 2)) (với arr1(num1, 2) là number) thì em chưa nghĩ ra cách để bẫy lỗi trường hợp này anh ạ, anh có thể cho em một đoạn code kiểm tra trường hợp này được không ạ!!!
Nếu bạn có thể chứng minh thuật toán đúng trong mọi trường hợp dữ liệu (hợp lệ) thì mới được. Không nên sử dụng một thuật toán chỉ vì chưa thấy nó sai. Trường hợp bạn đang nghiên cứu thì càng phải như vậy.Em nghĩ sữa lại vầy là được:
PHP:Sub move() Dim arr1, num1 As Long arr1 = Sheets("index").[A2:B6] For num2 = 1 To 2 For num1 = 1 To UBound(arr1) Sheets(arr1(num1, 1)).move after:=Sheets(arr1(num1, 2)) Next num1 Next num2 Sheets("index").Select End Sub
Đây là tình huống có vẽ đơn giản nhưng có nhiều vấn đề hửu ích để luyện tập viết code, nên mọi người mới trao đổi thêm với bạn để thấy rỏ hơn vấn đề, như nhiều lần bạn Vietmini nói tiêu chuẩn code hiệu quả không phải là ngắn nhất hay chạy nhanh nhất mà là cách giải quyết vấn đề rỏ ràng mạch lạc, các thành phần của code và toàn bộ code có thể kiểm soát được đầu vào và đầu ra, từ đó mới có khả năng lường hết các khả năng xảy ra, và khi cần điều chỉnh cũng sẽ dể dàng hơn.Bài này nói ăn may thì cũng không đúng lắm, thuật toán thì cũng hơi khó nhưng nó thuộc dạng toán đố, làm theo mẹo của câu đố này " Trong một cuộc đua 6 người , nếu người hạng 5 vượt qua người hạng 2 thì ông ta sẽ hạng mấy (before)"--"Khi người thứ hai bị người thứ ba vượt qua thì ông ta sẽ hạng mấy (after)". Các vị trí nếu đã sắp xếp đúng thì sắp xếp bao nhiêu lần nữa thì cũng vậy, những vị trí sai sẽ sắp xếp lại, em nghĩ trong bài này chỉ cần sắp 2 lần là được nếu để chắc ăn thì lên 100 lần, nếu dùng after thì có trường hợp 2 vị trí đầu sẽ sai, còn dùng before thì 2 trường hợp cuối sẽ sai vì vậy cùng cái code như trên thay after bằng before thì kết quả là như nhau. Đây là dạng bài toán sắp xếp chen ngang chứ không phải thay đổi vị trí, vì mỗi vòng lặp vị trí sẽ thay đổi. Bài dạng này ờ ngoài thực tế rất khó, cho dạng ban đầu rồi cho một kiểu sắp xếp sẵn , tìm số lần sắp xếp tối ưu nhất (ít nhất) (em đã từng đọc dạng bài này trong toán nâng cao lớp 5). Trong đây thì dùng vòng lặp để giải quyết , cư sắp xếp đến khi nào kết quả không đổi thì được vì vậy không phải là kết quả tối ưu.
Vâng, em sẽ chú ý chỗ này, làm bên công thức quen rồi, nên toàn ước đại thôi anh à, em còn phải học nhiều nữa!!!Đây là tình huống có vẽ đơn giản nhưng có nhiều vấn đề hửu ích để luyện tập viết code, nên mọi người mới trao đổi thêm với bạn để thấy rỏ hơn vấn đề, như nhiều lần bạn Vietmini nói tiêu chuẩn code hiệu quả không phải là ngắn nhất hay chạy nhanh nhất mà là cách giải quyết vấn đề rỏ ràng mạch lạc, các thành phần của code và toàn bộ code có thể kiểm soát được đầu vào và đầu ra, từ đó mới có khả năng lường hết các khả năng xảy ra, và khi cần điều chỉnh cũng sẽ dể dàng hơn.
Viết code, khó nhất là phải lường trước tất cả khả năng xảy ra và kiểm soát các khả năng nầy, khi mình còn nghi ngờ về một khả năng nào đó, đồng nghĩa code còn chưa hoàn chỉnh: "chỉ cần sắp 2 lần là được nếu để chắc ăn thì lên 100 lần"
Nếu bạn để ý thì sẽ thấy các công thức dùng tham chiếu vòng tôi không khuyến khích sử dụng. Làm chỉ mang tính chất nghiên cứu mà thôiEm chỉ đoán số vòng quay 2 là thấp nhấp thôi vì biết rằng từ 2 trở đi kết quả có thể không thay đổi nữa, còn xác định chính xác thì em chịu, ví dụ đơn giản gõ số 100 vào máy tính casio, hỏi là phải bấm căn 2 bao nhiêu lần để có kết quả là 1 với 5 chữ số thập phân, mình không thể biết được, nhưng với lập trình dùng Do while thì có thể chạy được số lần . Anh đã dùng interative caculation để làm bài toán dạng hồi quy, anh cho nó chạy vòng lặp xác định, vì đâu biết rằng đến khi nào nó cho kết quả không đổi!!!
Xếp kiểu này có trường hợp không đúng nha bạn.Néu ai có thuật toán mẹo gì thì tôi chưa biết. Chứ theo lô gic thuật toán "ăn chắc mặc bền" thì chỉ cần lập một mảng chứa tên tất cả các sheets theo thứ tự cần sắp xếp. Sau đó:
For i = 1 to Ubound(mang)-1
sheets(mang(i)).move before:=sheets(i)
Next i
Nếu muốn bẫy lỗi gì gì đó thì lúc sắp xếp cái mảng chứa tên sheets trên sẽ lòi ra.
Xin lỗi, tôi đọc không kỹ. Cách xếp bạn đưa ra là đúng rồi.Đó là lô gic tổng thể, nó chỉ có thể đúng hoặc không đúng. Không thể "có trường hợp không đúng"
' code sắp xếp tên sheet vào mảng theo thứ tự yêu cầu
' mảng sẽ xếp tên sheet theo thứ tự yêu cầu của chúng.
' Những sheets không có trong yêu cầu thì sẽ giữ lại vị trí TƯƠNG ĐỐI của chúng
Dim ordList() As String, reqList As Variant, staList as String
reqList = [range chứa yêu cầu] ' cột 1 chứa tên sheet, cột 2 chứa thứ tự yêu cầu
Redim ordList(1 to sheets.count)
for i = 1 to ubound(reqList)
ordList(reqList(i, 2)) = reqList(i, 1)
next i
staList = "," & Join(ordList, ",") & "," ' danh sách các sheets đã vào mảng
Dim lastBlank as integer
lastBlank = 1 ' đoán đại chỗ trống trong mảng sắp xếp, sẽ dò lại sau
for i = 1 to sheets.count ' định vị các sheets không có trong danh sách
if Instr(staList, "," & sheets(i).Name & ",") < 1 Then
For j = lastBlank to sheets.Count
if ordList(j) = "" Then ' chỗ này còn trống
ordList(j) = sheets(i).Name
lastBlank = j + 1
Exit For
End If
Next j
End If
next i
' đến đây thì ta có mảng ordList là mảng tên các sheets đã sắp xếp theo thứ tự yêu cầu
' code này nếu dùng ArrayList thì có thể nhanh và gọn hơn.
' code chỉ viết theo diễn giải thuật toán, chưa chạy thử
Excel cho phép dùng dấu phẩy (,) trong tên sheet nên khi kiểm tra trên chuỗi được nối bằng dấu phẩy (,) có thể xảy ra trường hợp ngoài mong muốn. Tôi nghĩ chỗ này nên dùng một ký tự mà Excel không cho phép dùng để đặt tên sheet.Vấn đề của tôi bây giờ là lập bảng sắp tên sheets. Nhất thời chưa nghĩ ra cách nào đặc sắc cho nên dùng kiểu rừng vậy
Mã:' code sắp xếp tên sheet vào mảng theo thứ tự yêu cầu ' mảng sẽ xếp tên sheet theo thứ tự yêu cầu của chúng. ' Những sheets không có trong yêu cầu thì sẽ giữ lại vị trí TƯƠNG ĐỐI của chúng Dim ordList() As String, reqList As Variant, staList as String reqList = [range chứa yêu cầu] ' cột 1 chứa tên sheet, cột 2 chứa thứ tự yêu cầu Redim ordList(1 to sheets.count) for i = 1 to ubound(reqList) ordList(reqList(i, 2)) = reqList(i, 1) next i staList = "," & Join(ordList, ",") & "," ' danh sách các sheets đã vào mảng Dim lastBlank as integer lastBlank = 1 ' đoán đại chỗ trống trong mảng sắp xếp, sẽ dò lại sau for i = 1 to sheets.count ' định vị các sheets không có trong danh sách if Instr(staList, "," & sheets(i).Name & ",") < 1 Then For j = lastBlank to sheets.Count if ordList(j) = "" Then ' chỗ này còn trống ordList(j) = sheets(i).Name lastBlank = j + 1 Exit For End If Next j End If next i ' đến đây thì ta có mảng ordList là mảng tên các sheets đã sắp xếp theo thứ tự yêu cầu ' code này nếu dùng ArrayList thì có thể nhanh và gọn hơn. ' code chỉ viết theo diễn giải thuật toán, chưa chạy thử
Cái này hay ở chỗ Ubound(mang)-1, vị trí cuối không cần sắp lại , vì khi các vị trí khác đã đúng thì tất nhiên vị trí cuối cùng cũng sẽ đúng luôn, ví sắp lại có thể dẫn đến bị sai, cám ơn anh!!!Néu ai có thuật toán mẹo gì thì tôi chưa biết. Chứ theo lô gic thuật toán "ăn chắc mặc bền" thì chỉ cần lập một mảng chứa tên tất cả các sheets theo thứ tự cần sắp xếp. Sau đó:
For i = 1 to Ubound(mang)-1
sheets(mang(i)).move before:=sheets(i)
Next i
Nếu muốn bẫy lỗi gì gì đó thì lúc sắp xếp cái mảng chứa tên sheets trên sẽ lòi ra.
Vâng cám ơn anh, em sẽ để ý chỗ này!!!Nếu bạn để ý thì sẽ thấy các công thức dùng tham chiếu vòng tôi không khuyến khích sử dụng. Làm chỉ mang tính chất nghiên cứu mà thôi
Ví dụ căn 2 mà bạn đưa ra. Sử dụng vòng lặp Do... While, trong đó thực hiện phép tính căn và kiểm tra kết quả là một giải pháp hoàn toàn phù hợp vì khi thoát vòng lặp bạn sẽ biết chắc chắn bài toán đưa ra có nghiệm hay không. Nếu có thì nghiệm là bao nhiêu.
Quay lại bài sắp xếp này, bạn cũng có thể dùng vòng lặp với bao nhiêu vòng tùy ý nhưng phải đảm bảo sau khi chạy macro các sheet chắc chắn đã được sắp xếp theo yêu cầu đưa ra. Có thể làm như trên là đưa vào Do... While và kiểm tra (kiểm tra sự thay đổi, đối chiếu với thứ tự cần sắp xếp)
Không phải vậy đâu bạn, không -1 cũng không thể sai vì vòng lặp duyệt các sheet theo thứ tự mà yêu cầu đặt ra (mảng đã sắp xếp) nên xếp đến sheet nào thì sheet đó đã ở đúng vị trí của nó (không chen ngang). Việc xếp sheet cuối vào vị trí cuối là không cần thiết mà thôi.Cái này hay ở chỗ Ubound(mang)-1, vị trí cuối không cần sắp lại , vì khi các vị trí khác đã đúng thì tất nhiên vị trí cuối cùng cũng sẽ đúng luôn, ví sắp lại có thể dẫn đến bị sai, cám ơn anh!!!
Bạn nghĩ xem cái này là do ai?Đoạn code mọi người cho ở trên em chạy trên file VD làm ví dụ thì OK lắm nhưng khi chạy trên file thực tế cần làm thì nó lại chạy không ra thứ tự gì.
Để có câu trả lời chuẩn và nhanh, bạn nên gởi file giống thực tế, dữ liệu có thể giả địnhĐoạn code mọi người cho ở trên em chạy trên file VD làm ví dụ thì OK lắm nhưng khi chạy trên file thực tế cần làm thì nó lại chạy không ra thứ tự gì. Bác VietMini nói thế thành ra chả ai giúp em. Thực ra e mới biết sử dụng macro thôi chứ để viết ra nó thì em chưa biết. Chắc là bác thấy file em gửi lên có macro ở trong nên bác nghĩ em biết mà không chịu làm lại đi nhờ người khác phải không ạ. Huhu em chưa biết thuật toán trong đó là gì ạ. Mong các bác biết thông thạo rồi thì bớt chút thời gian giúp em vì em đang cần gấp, sau này em sẽ cố gắng học.
Sub move()
Dim Arr1 As Variant, Arr2 As Variant, i As Long
Application.ScreenUpdating = False
Arr1 = Sheets("Index").Range("A2", Sheets("Index").Range("B" & Rows.Count).End(xlUp)).Value
ReDim Arr2(1 To UBound(Arr1))
For i = 1 To UBound(Arr1)
Arr2(Arr1(i, 2)) = CStr(Arr1(i, 1))
Next i
On Error Resume Next
Sheets(Arr2(1)).move Before:=Sheets(1)
For i = 2 To UBound(Arr2)
Sheets(Arr2(i)).move after:=Sheets(i - 1)
Next i
Sheets("index").Select
Application.ScreenUpdating = true
End Sub
Em cảm ơn bác nhiều nhiều !!!Để có câu trả lời chuẩn và nhanh, bạn nên gởi file giống thực tế, dữ liệu có thể giả định
Không chạy được do tên sheet là số
bạn dùng codeMã:Sub move() Dim Arr1 As Variant, Arr2 As Variant, i As Long Application.ScreenUpdating = False Arr1 = Sheets("Index").Range("A2", Sheets("Index").Range("B" & Rows.Count).End(xlUp)).Value ReDim Arr2(1 To UBound(Arr1)) For i = 1 To UBound(Arr1) Arr2(Arr1(i, 2)) = CStr(Arr1(i, 1)) Next i On Error Resume Next Sheets(Arr2(1)).move Before:=Sheets(1) For i = 2 To UBound(Arr2) Sheets(Arr2(i)).move after:=Sheets(i - 1) Next i Sheets("index").Select Application.ScreenUpdating = true End Sub
Sao em nhìn code Anh, nhưng muốn học code Anh mà khó lắm Anh,Để có câu trả lời chuẩn và nhanh, bạn nên gởi file giống thực tế, dữ liệu có thể giả định
Không chạy được do tên sheet là số
bạn dùng codeMã:Sub move() Dim Arr1 As Variant, Arr2 As Variant, i As Long Application.ScreenUpdating = False Arr1 = Sheets("Index").Range("A2", Sheets("Index").Range("B" & Rows.Count).End(xlUp)).Value ReDim Arr2(1 To UBound(Arr1)) For i = 1 To UBound(Arr1) Arr2(Arr1(i, 2)) = CStr(Arr1(i, 1)) Next i On Error Resume Next Sheets(Arr2(1)).move Before:=Sheets(1) For i = 2 To UBound(Arr2) Next i Sheets("index").Select Application.ScreenUpdating = true End Sub
Bạn phải hiểu thuật toán trướcSao em nhìn code Anh, nhưng muốn học code Anh mà khó lắm Anh,
Sheets(Arr2(1)).move Before:=Sheets(1)
Đoạn này em chưa hiểu lắm. Mong Ang chỉ dạy thêm.
Chúc Anh ngày vui.
Arr2(Arr1(i, 2)) = CStr(Arr1(i, 1))
Còn dòng lệnh nữa này Anh? Em chưa hiểu?CStr(Arr1(i, 1))
Lệnh Sheets(Arr2(i)), nếu Arr2(i) là số thì VBA hiểu là sheet thứ Arr2(i), nhưng mục tiêu là lấy tên sheet Arr2(i), do đó cần chuyển số thành chuỗi bằng hàm Cstr, còn có phải viết tắt hay không thì không rỏCòn dòng lệnh nữa này Anh? Em chưa hiểu?PHP:Arr2(Arr1(i, 2)) = CStr(Arr1(i, 1))
từ CStr là từ viết tắt phải không Anh?
Em cảm ơn Anh,.
Chúc Anh ngày vui!
Dạ, cái này em phải từ từ nghiên cứu thêm, có gì không hiểu em hỏi Anh nhé!Lệnh Sheets(Arr2(i)), nếu Arr2(i) là số thì VBA hiểu là sheet thứ Arr2(i), nhưng mục tiêu là lấy tên sheet Arr2(i), do đó cần chuyển số thành chuỗi bằng hàm Cstr, còn có phải viết tắt hay không thì không rỏ
Mình đã chuyển tên sheet thành chuỗi trước đó rồisheets là một collection. Toán tử ( ) - dấu ngoặc - của loại collection này nhận 2 loại tham để truy trị. Nếu tham là số thì nó coi như là tìm theo chỉ số và truy theo vi trí. Nếu tham là chuỗi thì nó coi như là tìm theo tên.
Muón bảo đảm là tìm theo tên thì chỉ cần làm như sau - hàm CStr đổi số thành chuỗi:
Sheets(CStr(Arr2(1))).move Before:=Sheets(1)
For i = 2 To UBound(Arr2)
Sheets(CStr(Arr2(i))).move after:=Sheets(i - 1)
Next i
Làm chi cho lòng vòng vậy?Mình đã chuyển tên sheet thành chuỗi trước đó rồi
For i = 1 To UBound(Arr1)
Arr2(Arr1(i, 2)) = CStr(Arr1(i, 1))
Next i
Xếp thứ tự trước cho chắc ăn, khỏi phải mệt óc đoán các khả năng xảy ra để xét hàm IfLàm chi cho lòng vòng vậy?
Bất cứ 1 chuỗi (hay biến nào) mà muốn đưa vào làm tên sheet, bạn cứ cho nó vào hàm CStr() là xong chứ gì, đâu cần phải để ý nó là text hay number. Tức là xử lý ngay lúc đưa vào tên sheet chứ không phải thông qua 1 vòng lập lòng vòng thế kia đâuXếp thứ tự trước cho chắc ăn, khỏi phải mệt óc đoán các khả năng xảy ra để xét hàm If
Mảng Arr1 lấy từ cột A và B chưa xếp thứ tự theo vị trí các sheetBất cứ 1 chuỗi (hay biến nào) mà muốn đưa vào làm tên sheet, bạn cứ cho nó vào hàm CStr() là xong chứ gì, đâu cần phải để ý nó là text hay number. Tức là xử lý ngay lúc đưa vào tên sheet chứ không phải thông qua 1 vòng lập lòng vòng thế kia đâu
Tôi thường làm vậy và thấy rất chắc ăn!
Bạn thử di chuyển bằng tay sheet code name xem có được không? Nếu bằng tay làm được thì code VBA sẽ làm được và ngược lạiAnh Chị! cho em xin Macro xắp xếp codeName
kích 1 cái là xắp xếp codeName tăng dần. Em xin cảm ơn
được 1 sheets thôi anh ạ:Bạn thử di chuyển bằng tay sheet code name xem có được không? Nếu bằng tay làm được thì code VBA sẽ làm được và ngược lại
à! em nói sai ýBạn thử di chuyển bằng tay sheet code name xem có được không? Nếu bằng tay làm được thì code VBA sẽ làm được và ngược lại
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 nói sai ý
Ý em muốn các sheets đang lộn xộn muốn xắp xếp về theo thứ tự của CodeName
Nếu so sánh dạng text thì không sao, còn bạn muốn so sánh kiểu sheet1 < sheet2< sheet9 < sheet10 thì có nhiều trường hợp. Ví dụ code name của excel tiếng Việt là Trang_tính1·hoặc bạn có thể sửa codename thành abc chẳng hạn, cần giới hạn trong các codename được sinh ra tự động chưa sửa chữa thôi.à! em nói sai ý
Ý em muốn các sheets đang lộn xộn muốn xắp xếp về theo thứ tự của CodeName
+ CodeName có thứ tự tăng dần sheet1-sheet9 ko thể dịch chuyển trừ sửa tên CodeNameVẫn chưa hình dung ra được sẽ sắp xếp thế nào! Bạn cho 1 ví dụ xem
bạn dùng code này thử:+ 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 ạ
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ộ embạ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
Bạn thử chưa vậy? Bạn có thể gửi cái file mẫu lên đây được khô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
Code của bạn sort theo name, chủ topic cần sort theo codename mà.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
Anh thử code này thử:Code của bạn sort theo name, chủ topic cần sort theo codename mà.
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..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
Em cảm ơn Anh, giải thuật của Anh rất hay. Em sẽ copy về để học.@ 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ó 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 ạ!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)
Bạn đặt tên sheet có 3 ký tự như 001, 002, 003, ...,100,101 sẽ sắp xếp được.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 ạ!
Good idea,Bạn đặt tên sheet có 3 ký tự như 001, 002, 003, ...,100,101 sẽ sắp xếp được.
.