Lọc Thời gian trùng và tính thời gian

[thaonhi1]

Trong Sheet THOIGIAN :
có 1 dảy thời gian từ A2:A3937 chưa lọc những dữ liệu về thời gian trùng nhau.
Có 1 dảythời gian từ E2:E157 đã lọc nhửng dữ liệu về thời gian trùng nhau.

Mình Cần danh sách từ 01/1999 đến 12/2003 tại Ô A4 của Sheet 1
Danh sách từ 01/2004 đến 12/2004 tại Ô A4 của sheet 2
danh sách từ 01/2005 đến nay tại Ổ A4 của Sheet 3.

Tại Ô C4, E4,....Của các Sheet1,2,3 Mình muốn lấy dữ liệu về tháng/năm của những tháng tiếp theo, Khi tháng trước là tháng 12/năm thì ô sau là tháng 1/năm+1.
Các bạn giúp mình với. cảm ơn nhiều


Các bạn giúp mình nhé .
Cảm ơn nhiều.

 

[SA_DQ]

Thực hiện phần I của bạn đây, xem thêm trong file kèm theo

Trong Sheet THOIGIAN : có 1 dảy thời gian từ A2:A3937 chưa lọc những dữ liệu về thời gian trùng nhau.
Có 1 dảy thời gian từ E2:E157 mình đã lọc nhửng dữ liệu về thời gian trùng nhau.
Mình Cần danh sách từ 01/1999 đến 12/2003 tại Ô A4 của Sheet 1
Danh sách từ 01/2004 đến 12/2004 tại Ô A4 của sheet 2
danh sách từ 01/2005 đến nay tại Ổ A4 của Sheet 3.
Sheet THOIGIAN là Sheet mà mình lấy dữ liệu từ CSDL, nên có thể có đủ năm từ 1999 đến bây giờ,

Macro sự kiện ở 3 trang tính là giống nhau; Sau đây là đại diện:

Option Explicit
Private Sub Worksheet_Change(ByVal Target As Range)
 If Not Intersect(Target, [B4]) Is Nothing Then
   Dim Sh As Worksheet, Rng As Range
   Dim eRw As Long
 
   Set Sh = Sheets("ThoiGian"):        eRw = Sh.[A65500].End(xlUp).Row
   Sh.[h2].Value = Target.Value:       Range([B6], [C123]).ClearContents
   Sh.Range(Sh.[H5], Sh.Cells(eRw, "I")).ClearContents
 
   Sh.Range("A1:D2" & eRw).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range _
        ("H1:H2"), CopyToRange:=Sh.Range("H4:I4"), Unique:=False
   eRw = 2 * Sh.[h65500].End(xlUp).Row
   Sh.Range(Sh.[H5], Sh.Cells(eRw, "I")).Copy Destination:=[B6]
 End If
End Sub

Còn muốn:

Tại Ô C4, E4,....Của các Sheet1,2,3 Mình muốn lấy dữ liệu về tháng/năm của những tháng tiếp theo, Khi tháng trước là tháng 12/năm thì ô sau là tháng 1/năm+1.

thì phải xuất phát từ hướng khác.

 

[thaonhi1]

Cảm ơn bạn HYen17 rất nhiều.
"đưa người thì đưa qua sông, Giúp người thì giúp cho chót ..." Không biết đúng không ta.

Tính thời gian của các ô tiếp theo C4,E4... và lấy dữ liệu DOANH SO và LAI của các ô đó, bạn giúp mình luôn nhé.
Thank.

 

[SA_DQ]

Đã trót thì trét, đành vậy chứ biết làm sao

Bạn cho chay lần lượt 3 macro đầu nha; Chúng nó, đến phiên mình sẽ lần lượt gọi macro cuối để truyền các tham số & Run cho xong nhiệm vụ!

Option Explicit
[B]Sub Trang1()[/B]
   Sheets("Sheet1").Select:                           FilterValues "A"
[B]End Sub[/B]

[B]Sub Trang2()[/B]
   Sheets("Sheet2").Select:                           FilterValues "B"
[B]End Sub[/B]

[B]Sub Trang3()[/B]
   Sheets("Sheet3").Select:                           FilterValues "C"
[B]End Sub[/B]

Sub FilterValues(ThuTu As String)
 Dim M123 As Byte, Jj As Byte, BDau As Byte, KThuc As Byte
 Dim Sh As Worksheet, Rng As Range
 Dim eRw As Long, lRw As Long
 
 M123 = Switch(ThuTu = "A", 59, ThuTu = "B", 11, ThuTu = "C", (Year(Date) - 2004) * 12)
 BDau = Switch(ThuTu = "A", 2, ThuTu = "B", 62, ThuTu = "C", 74)
 Set Sh = Sheets("ThoiGian"):                         eRw = Sh.[A65500].End(xlUp).Row
 Application.ScreenUpdating = False:                  Rows("6:60").ClearContents
 For Jj = BDau To (BDau + M123)
   If Sh.Cells(Jj, 6).Value = "" Then Exit For
   Sh.[h2].Value = Sh.Cells(Jj, 6).Value
   Sh.Range(Sh.[H5], Sh.Cells(eRw, "I")).ClearContents
   Sh.Range("A1:D2" & eRw).AdvancedFilter Action:=xlFilterCopy, CriteriaRange:=Sh.Range _
        ("H1:H2"), CopyToRange:=Sh.Range("H4:I4"), Unique:=False
   lRw = 2 * Sh.[h65500].End(xlUp).Row
   Sh.Range(Sh.[H5], Sh.Cells(lRw, "I")).Copy Destination:=Cells(6, 2 * (Jj - BDau + 1))
   Cells(3, 2 * (Jj - BDau + 1)).Value = Sh.[h2].Value  '<=|4'
 Next Jj
End Sub

 

[SA_DQ]

To: Thaonhi1;164020!

bạn giúp mình luôn nhé.Thank.

Tặng thêm bạn macro này để tiện lúc bạn thoát khỏi file excel này một cách lẹ làng!

Option Explicit
Private Sub Workbook_BeforeClose(Cancel As Boolean)
 Dim jJ   As Byte
 
 For jJ = 1 To 3
   Sheets(jJ).Select
   Union(Rows(3), Rows("6:50")).ClearContents
 Next jJ
End Sub