Lọc theo điều kiện (1 người xem)

[Nguoiay]

Chào cả nhà! Em muốn lọc dữ liêu theo ngày, đối tượng. Em đã viết:

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$L$3" Then
        Application.ScreenUpdating = False
        S2.Range("A10:J10000").Clear
        With S1.Range(S1.[A1], S1.[A20000].End(3)).Resize(, 15)
            .AutoFilter 1, ">=" & CLng(S2.Range("L1").Value), 1, "<=" & CLng(S2.Range("L2").Value)
            .AutoFilter 7, S2.Range("L3")
            .Offset(1, 0).Resize(, 2).SpecialCells(12).Copy S2.Range("A10")
            .Offset(1, 4).Resize(, 1).SpecialCells(12).Copy S2.Range("C10")
            .Offset(1, 7).Resize(, 3).SpecialCells(12).Copy S2.Range("D10")
            .AutoFilter
        End With
    End If
End Sub

Em vẫn chưa làm xong hết nhưng test thử không chạy ạ. Nhờ mọi người giúp em thêm nhé!

 

[giaiphap]

Bạn sửa lại vầy thử xem.

Private Sub Worksheet_Change(ByVal Target As Range)
    If Target.Address = "$L$3" Then
        Application.ScreenUpdating = False
        S2.Range("A10:J10000").Clear
        With S1.Range(S1.[A1], S1.[A20000].End(3)).Resize(, 15)
            .AutoFilter Field:=1, Criteria1:=">=" & S2.Range("L1").Value, Operator:=xlAnd, Criteria2:="<=" & S2.Range("L2").Value
            .AutoFilter 7, Format(S2.Range("L3"), "00000")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).SpecialCells(12).Copy S2.Range("A10")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 4).Resize(, 1).SpecialCells(12).Copy S2.Range("C10")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 7).Resize(, 3).SpecialCells(12).Copy S2.Range("D10")
            .AutoFilter
        End With
    End If
End Sub

 

[Nguoiay]

Em đã áp dụng và chạy thử. Giờ nó lại lỗi vì không lọc đúng theo điều kiện ngày:

Private Sub Worksheet_Change(ByVal Target As Range)
    Dim dongdau As Integer
    Dim eR As Long
    If Target.Address = "$N$3" Then
        Application.ScreenUpdating = False
        S2.Range("A10:L10000").Clear
        With S1.Range(S1.[A1], S1.[A20000].End(3)).Resize(, 17)
            .AutoFilter Field:=1, Criteria1:=">=" & S2.Range("N1").Value, Operator:=xlAnd, Criteria2:="<=" & S2.Range("N2").Value
            .AutoFilter 7, Format(S2.Range("N3"), "00000")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).SpecialCells(12).Copy S2.Range("A10")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 4).Resize(, 1).SpecialCells(12).Copy S2.Range("C10")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 7).Resize(, 3).SpecialCells(12).Copy S2.Range("D10")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 12).Resize(, 1).SpecialCells(12).Copy S2.Range("G10")
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 10).Resize(, 1).SpecialCells(12).Copy S2.Range("H10")
            .Offset(1, 13).Resize(, 1).SpecialCells(12).Copy
            S2.Range("I10").PasteSpecial xlPasteValuesAndNumberFormats
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 14).Resize(, 1).SpecialCells(12).Copy 'S2.Range("J10")
            S2.Range("J10").PasteSpecial xlPasteValuesAndNumberFormats
             S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 15).Resize(, 1).SpecialCells(12).Copy 'S2.Range("J10")
            S2.Range("K10").PasteSpecial xlPasteValuesAndNumberFormats
            S1.Range(S1.[A2], S1.[A20000].End(3)).Resize(, 2).Offset(, 16).Resize(, 1).SpecialCells(12).Copy 'S2.Range("L10")
            S2.Range("L10").PasteSpecial xlPasteValuesAndNumberFormats
            .AutoFilter
        End With
        dongdau = 10
        eR = S2.Range("A65000").End(3).Row
        With S2.Range("A" & dongdau - 2 & ":L" & eR).Offset(1)
            .BorderAround LineStyle:=1
            .Borders(11).LineStyle = 1: .Borders(11).ColorIndex = 1
            .Borders(12).LineStyle = 1: .Borders(12).ColorIndex = 1: .Borders(xlInsideHorizontal).Weight = xlThin
        End With
        S7.Range("A4:L10").Copy S2.[A65000].End(3).Offset(1)
        With S2
            .Cells(eR + 1, 7).Resize(, 6).FormulaR1C1 = "=SUM(R10C:R[-1]C) "
            .Cells(eR + 1, 7).Resize(, 6).Value = .Cells(eR + 1, 7).Resize(, 6).Value
            .Cells(eR + 2, 12).Resize(, 1).Value = "=R[-1]C[-1]-R[-1]C"
        End With
        With S2
            .Range("A10:L" & eR).Font.Name = "Times New Roman"
            .Range("A10:L" & eR).Font.Size = 10
        End With
    End If
End Sub

Nhờ mọi người xem thêm cho em ạ!

 

[Nguoiay]

Mọi xem thêm cho em với nhé!
Em cám ơn nhiều!

 

[Nguoiay]

Mọi xem dùm cho em với ạ!

 

[dhn46]

Bạn thử chỉnh đoạn

           .AutoFilter Field:=1, Criteria1:=">=" & S2.Range("N1").Value, Operator:=xlAnd, Criteria2:="<=" & S2.Range("N2").Value

thành

           .AutoFilter Field:=1, Criteria1:=">=" & S2.Range("N1").Value2, Operator:=xlAnd, Criteria2:="<=" & S2.Range("N2").Value2

 

[Nguoiay]

Em muốn hỏi thêm 1 câu nữa: Mình phải sửa code như thế nào để khi mình nhập mã hội viên nếu trong khoảng thời gian chọn không thỏa mãn thì nó thông báo: Hội viên này không có phát sinh. Hiện tại em chưa xử lý được ah.

 

[Ba Tê]

Em muốn hỏi thêm 1 câu nữa: Mình phải sửa code như thế nào để khi mình nhập mã hội viên nếu trong khoảng thời gian chọn không thỏa mãn thì nó thông báo: Hội viên này không có phát sinh. Hiện tại em chưa xử lý được ah.

Không chỉnh sửa code của bạn, viết lại theo kiểu khác được không?
Bạn xem file nếu được thì xài nhé.