Lọc dữ liệu theo 2 điều kiện

[Phương Phương mito]

Kính gửi anh chị,
Em có dữ liệu đầu vào như sheet Data. Giờ em muốn lọc tách biệt theo từng Tên màu cách nhau một dòng và theo điều kiện Ngày xuất lớn hơn bằng tại C1 và nhỏ hơn bằng C2 như kết quả tại sheet Ket_qua thì làm thế nào ạ. Em cảm ơn anh chị ạ !

 

[Hoàng Trọng Nghĩa]

Kính gửi anh chị,
Em có dữ liệu đầu vào như sheet Data. Giờ em muốn lọc tách biệt theo từng Tên màu cách nhau một dòng và theo điều kiện Ngày xuất lớn hơn bằng tại C1 và nhỏ hơn bằng C2 như kết quả tại sheet Ket_qua thì làm thế nào ạ. Em cảm ơn anh chị ạ !

Bạn thử dùng thủ tục dưới đây nhé!

Sub XuLyDuLieu()
    Dim e As Long
    Dim shtData As Worksheet, shtKetQua As Worksheet
    Set shtData = Worksheets("Data")
    Set shtKetQua = Worksheets("Ket_qua")
    e = shtData.Range("D" & shtData.Rows.Count).End(xlUp).Row
    With shtData.Sort
        .SortFields.Clear
        .SortFields.Add2 Key:=Range("G2:G" & e), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SortFields.Add2 Key:=Range("I2:I" & e), SortOn:=xlSortOnValues, Order:=xlAscending, DataOption:=xlSortNormal
        .SetRange Range("A1:L" & e)
        .Header = xlYes
        .MatchCase = False
        .Orientation = xlTopToBottom
        .SortMethod = xlPinYin
        .Apply
    End With
    
    Dim c As Byte
    Dim arrData, arrKetQua
    Dim n As Long, r As Long, u As Long
    Dim dteBatDau As Date, dteKetThuc As Date
    
    dteBatDau = shtKetQua.Range("C1").Value
    dteKetThuc = shtKetQua.Range("C2").Value
    arrData = shtData.Range("A2:L" & e).Value
    u = UBound(arrData)
    ReDim arrKetQua(1 To u * 2, 1 To 12)
    For r = 1 To u
        If arrData(r, 9) >= dteBatDau And arrData(r, 9) <= dteKetThuc Then
            n = n + 1
            For c = 1 To 12
                If n > 1 Then
                    If arrKetQua(n - 1, 7) > "" And arrData(r, 7) <> arrKetQua(n - 1, 7) Then
                        n = n + 1
                    End If
                    arrKetQua(n, c) = arrData(r, c)
                Else
                    arrKetQua(n, c) = arrData(r, c)
                End If
            Next
        End If
    Next
    e = shtKetQua.Range("D" & shtData.Rows.Count).End(xlUp).Row + 1
    shtKetQua.Range("A" & e).Resize(n, 12).Value = arrKetQua
End Sub