Nhờ giúp thêm lệnh Sort vào code (1 người xem)

[JinRua]

Em sưu tầm đoạn Code sau để lọc dữ liệu, em muốn sau khi AdvancedFilter thì sort theo cột BC (sắp xếp theo ngày tăng dần từ BC7 trở xuống) rồi mới thực hiện lệnh Copy. Nhờ các anh chị chỉ bảo giúp. Chân thành cảm ơn!

"Private Sub Worksheet_Change(ByVal Target As Range)
If Not Intersect(Target, [d3]) Is Nothing Then
Dim Sh As Worksheet, Rng As Range, Rws As Long

Set Sh = ThisWorkbook.Worksheets("CSDL")
Rws = Sh.[b5].CurrentRegion.Rows.Count
[b5].Resize(94, 5).ClearContents
Rows("5:99").Hidden = False
Sh.Range("C6").Resize(Rws, 26).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range _
("BC1:BC2"), CopyToRange:=Sh.Range("BA6:Be6"), Unique:=False
Sh.[bb7].CurrentRegion.Offset(1).Copy Destination:=[b5]
Rws = [b99].End(xlUp).Row + 3
Rows(Rws & ":98").Hidden = True
End If
End Sub"

 

[JinRua]

Có ai biết câu lệnh sort theo điều kiện bài #1 thế nào chỉ cho biết với !

 

[ndu96081631]

Có ai biết câu lệnh sort theo điều kiện bài #1 thế nào chỉ cho biết với !

Hổng thấy dữ liệu mà bạn cứ kêu người ta "sọt"
Vậy thì "sot" chay hả bạn? Rồi làm sao kiểm tra để biết là nó "ra" đúng

 

[JinRua]

Xin lỗi các anh, chị. Em gửi file ạ.

 

[ndu96081631]

Xin lỗi các anh, chị. Em gửi file ạ.

Thì Sort bình thường thôi (bạn có thể record macro để có code)

Private Sub Worksheet_Change(ByVal Target As Range)
 [COLOR=#0000cd]If Target.Address = "$D$3" Then[/COLOR]
   Dim Sh As Worksheet, Rng As Range, Rws As Long
 
   Set Sh = ThisWorkbook.Worksheets("CSDL")
   Rws = Sh.[b5].CurrentRegion.Rows.Count
   [b5].Resize(94, 5).ClearContents
   Rows("5:99").Hidden = False
   Sh.Range("C6").Resize(Rws, 26).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range _
        ("BC1:BC2"), CopyToRange:=Sh.Range("BA6:Be6"), Unique:=False
   [COLOR=#ff0000]With Sh.Range("BA6").CurrentRegion
     .Sort .Cells(1, 3), 1, Header:=xlYes
   End With[/COLOR]
   Sh.[bb7].CurrentRegion.Offset(1).Copy Destination:=[b5]
   Rws = [b99].End(xlUp).Row + 3
   Rows(Rws & ":98").Hidden = True
 End If
End Sub

Chổ màu đỏ là chổ thêm vào
Chổ màu xanh là chổ tôi sửa lại (cho đẹp)
----------------
Bạn cũng.. "hay" thật đấy! Đưa file lên nhờ giúp còn bày đặt password

 

[JinRua]

Ôi xin lỗi bác ndu96081631 vội quá quên bỏ password.
Cảm ơn bác nhiều em gửi lại bài #4.

 

[ndu96081631]

em gửi lại bài #4.

Xong cả rồi còn gửi làm gì chứ?

 

[JinRua]

Bác ndu96081631 ơi em thử thấy sort theo năm không phải theo ngày bác ạ.

 

[ndu96081631]

Bác ndu96081631 ơi em thử thấy sort theo năm không phải theo ngày bác ạ.

Theo ngày nghĩa là sao?
Cứ ngày nhỏ ở trên, ngày lớn ở dưới và không quan tâm đến THÁNG và NĂM à?

 

[ndu96081631]

Theo ngày nghĩa là sao?
Cứ ngày nhỏ ở trên, ngày lớn ở dưới và không quan tâm đến THÁNG và NĂM à?

Trong khi chờ đợi bạn trả lời, tôi làm theo ý tôi xem sao:

Private Const cList = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$D$3" Then
   Dim wks As Worksheet
   Application.AddCustomList Split(cList, ",")
   Set wks = ThisWorkbook.Worksheets("CSDL")
   With Range("B5:F94")
     .ClearContents
     .EntireRow.Hidden = False
   End With
   With wks
     .Range("C6:C10000").Resize(, 26).AdvancedFilter 2, .Range("BC1:BC2"), .Range("BA6:BE6")
     With .Range("BA6").CurrentRegion
       .Offset(, 2).Resize(, 1).NumberFormat = "d"
       .Sort .Cells(1, 3), 1, , , , , , xlYes, Application.CustomListCount + 1
       .Offset(, 2).Resize(, 1).NumberFormat = "dd/mm/yyyy"
       .Offset(1).Copy Range("B5")
     End With
   End With
   Range([B99].End(xlUp).Offset(3), [B98]).EntireRow.Hidden = True
 End If
End Sub

Ai đang dùng Excel 2003 vui lòng thử code này giúp tôi với

 

[Hong.Van]

Trong khi chờ đợi bạn trả lời, tôi làm theo ý tôi xem sao:

Private Const cList = "1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17,18,19,20,21,22,23,24,25,26,27,28,29,30,31"
Private Sub Worksheet_Change(ByVal Target As Range)
 If Target.Address = "$D$3" Then
   Dim wks As Worksheet
   Application.AddCustomList Split(cList, ",")
   Set wks = ThisWorkbook.Worksheets("CSDL")
   With Range("B5:F94")
     .ClearContents
     .EntireRow.Hidden = False
   End With
   With wks
     .Range("C6:C10000").Resize(, 26).AdvancedFilter 2, .Range("BC1:BC2"), .Range("BA6:BE6")
     With .Range("BA6").CurrentRegion
       .Offset(, 2).Resize(, 1).NumberFormat = "d"
       .SortSpecial 1, .Cells(1, 3), 1, , , , , , xlYes, Application.CustomListCount + 1
       .Offset(, 2).Resize(, 1).NumberFormat = "dd/mm/yyyy"
       .Offset(1).Copy Range("B5")
     End With
   End With
   Range([B99].End(xlUp).Offset(3), [B98]).EntireRow.Hidden = True
 End If
End Sub

Ai đang dùng Excel 2003 vui lòng thử code này giúp tôi với

Chọn Dropbox D3 thấy File chạy tốt đó thầy!

 

[ndu96081631]

Chọn Dropbox D3 thấy File chạy tốt đó thầy!

Cảm ơn!
Tôi mới sửa lại code lần nữa (không dùng SortSpecial mà Sort bình thường)
Bạn vui lòng test lại giúp tôi với
(Excel 2003 nha)
Vấn đề quan trọng là sau khi chọn Validation tại D3 xong, code chạy, bạn nhìn xem cột ngày tháng (cột D) có được sort THEO NGÀY hay không? Tức ngày nhỏ ở trên, ngày lớn ở dưới (Không quan tâm THÁNG và NĂM)

 

[Hong.Van]

Cảm ơn!
Tôi mới sửa lại code lần nữa (không dùng SortSpecial mà Sort bình thường)
Bạn vui lòng test lại giúp tôi với
(Excel 2003 nha)
Vấn đề quan trọng là sau khi chọn Validation tại D3 xong, code chạy, bạn nhìn xem cột ngày tháng (cột D) có được sort THEO NGÀY hay không? Tức ngày nhỏ ở trên, ngày lớn ở dưới (Không quan tâm THÁNG và NĂM)

Gởi thầy cái hình

 

[ndu96081631]

Gởi thầy cái hình

Yeh!
Vì không muốn dùng vòng lập For mà phải "mò" từ chiều đến giờ. Làm bằng tay được mà record macro nó ra cái quỷ gì đâu không!
Ẹc... Ẹc... Cảm ơn bạn nhiều

 

[JinRua]

Vâng đúng theo í muốn. Code chạy rất tốt. Cảm ơn ndu96081631 và Hong.Van