Lọc dữ liệu trùng theo điều kiện (1 người xem)

[nhathuyha]

Chào các thầy cùng các anh chị trong diễn đàn!

mọi người có thể giúp em lọc bỏ những dòng dữ liệu bị trùng sao cho dòng nào có "time" lớn hơn thì dữ lại,
còn những dòng có "time" nhỏ hơn thì xóa đi..Mình có tạo 1 nút bấm ở sheet 1.Bấm vào là chạy thôi
các anh chị để ý một chút thì thấy rằng cột E là cột Time.. thật ra em đã chuyển nó qua dạng số rồi.. Vd nhé.. số seri bị trùng là 1234 có số lần bị trùng là 3 lần thì nó lấy lần có giá trị "time" lớn nhất giữ lại và xóa dòng của 2 dữ liệu kia
Lưu ý 1 chút là dữ liệu này có thể trùng nhiều lần và chỉ lấy 1 dòng duy nhất có "time" lớn nhất thôi.

Chân thành cảm ơn các thầy cùng các anh chị trong diễn đàn

 

[nhathuyha]

Đề bài này chưa rõ ràng chỗ:
1) Thằng 261070ZM0F77LD3 xuất hiện ở "Mã 3" ...3 lần & 'mã 2" ...2 lần ==> "xử" nó làm sao ?
2) Thằng 26105Z440F77LDL xuất hiện ở "Mã 3" ...1 lần & "mã 2" ...1 lần ==> "xử" nó làm sao ?
Híc
Thân

dạ anh, con 261070ZM0F77LD3 xuất hiện tổng cộng 5 lần trong vùng mã 2 và 3 thì chọn ra 1 con có giá trị "time" lớn nhất rồi giữ lại ạ
còn con 26105Z440F77LDL xuất hiện tổng cộng 2 lần trong vùng mã 2 và 3 thì cũng chọn ra 1 con có giá trị "time" lớn nhất rồi giữ lại.
Chỉ khó ở chỗ cũng là con 261070ZM0F77LD3 nhưng nó xuất hiện thêm ở vùng mã 1.. thì mình không làm gì con này hết, vẫn để nguyên ạ.
Chỉ lọc những con nào trùng nằm trong vùng có mã là 2 và 3 thôi ạ.

 

[nhathuyha]

Đề bài này chưa rõ ràng chỗ:
1) Thằng 261070ZM0F77LD3 xuất hiện ở "Mã 3" ...3 lần & 'mã 2" ...2 lần ==> "xử" nó làm sao ?
2) Thằng 26105Z440F77LDL xuất hiện ở "Mã 3" ...1 lần & "mã 2" ...1 lần ==> "xử" nó làm sao ?
Híc
Thân

dạ anh, con 261070ZM0F77LD3 xuất hiện tổng cộng 5 lần trong vùng mã 2 và 3 thì chọn ra 1 con có giá trị "time" lớn nhất rồi giữ lại ạ
còn con 26105Z440F77LDL xuất hiện tổng cộng 2 lần trong vùng mã 2 và 3 thì cũng chọn ra 1 con có giá trị "time" lớn nhất rồi giữ lại.
Chỉ khó ở chỗ cũng là con 261070ZM0F77LD3 nhưng nó xuất hiện thêm ở vùng mã 1.. thì mình không làm gì con này hết, vẫn để nguyên ạ.
Chỉ lọc những con nào trùng nằm trong vùng có mã là 2 và 3 thôi ạ.

 

[nhathuyha]

bạn dùng code mới thử xem có đúng ý không

Public Sub XoaTrung()
Dim Dic As Object, Darr(), Rng As Range, i As Long, tmp As String
Application.ScreenUpdating = False
Sheets("Sheet1").Activate
Darr = Sheets("Data").Range("A1:Y" & Sheets("Data").Range("E65500").End(xlUp).Row).Value
Range("A1:Y" & Range("A65500").End(xlUp).Row).ClearContents
Range("A1").Resize(UBound(Darr), UBound(Darr, 2)) = Darr
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Darr)
    [COLOR=#ff0000]If Right(Darr(i, 3), 1) = "2" Or Right(Darr(i, 3), 1) = "3" Then[/COLOR]
        tmp = Darr(i, 1)
        If Not Dic.Exists(tmp) Then
            Dic.Add tmp, Array(Darr(i, 5), i)
        ElseIf Darr(i, 5) >= Dic.Item(tmp)(0) Then
            If Rng Is Nothing Then
                Set Rng = Range("A" & Dic.Item(tmp)(1))
            Else
                Set Rng = Union(Rng, Range("A" & Dic.Item(tmp)(1)))
            End If
            Dic.Item(tmp) = Array(Darr(i, 5), i)
        End If
    [COLOR=#ff0000]End If[/COLOR]
Next i
Rng.Select
Selection.EntireRow.Delete
Range("A1").Select
Set Dic = Nothing:  Set Rng = Nothing:  Erase Darr
Application.ScreenUpdating = True
End Sub

dạ anh, cảm ơn anh rất nhiều ạ. có lẽ là ổn nhất rồi ạ.. chỗ Sheets("Sheet1").Activate em sửa lại 1 chút là Sheets("Data").Activate để nó lọc và lưu ngay trên sheet Data luôn cũng được anh nhỉ ?

 

[HieuCD]

dạ anh, cảm ơn anh rất nhiều ạ. có lẽ là ổn nhất rồi ạ.. chỗ Sheets("Sheet1").Activate em sửa lại 1 chút là Sheets("Data").Activate để nó lọc và lưu ngay trên sheet Data luôn cũng được anh nhỉ ?

dĩ nhiên là được, nhưng bạn nên xóa 2 dòng màu đỏ

Public Sub XoaTrung()
Dim Dic As Object, Darr(), Rng As Range, i As Long, tmp As String
Application.ScreenUpdating = False
[COLOR=#000080]Sheets("Data").Activate[/COLOR]
[COLOR=#000080]Darr = Range("A1:Y" & Range("E65500").End(xlUp).Row).Value[/COLOR]
[COLOR=#ff0000]'Range("A1:Y" & Range("A65500").End(xlUp).Row).ClearContents[/COLOR]
[COLOR=#ff0000]'Range("A1").Resize(UBound(Darr), UBound(Darr, 2)) = Darr[/COLOR]
Set Dic = CreateObject("Scripting.Dictionary")
For i = 2 To UBound(Darr)
    If Right(Darr(i, 3), 1) = "2" Or Right(Darr(i, 3), 1) = "3" Then
        tmp = Darr(i, 1)
        If Not Dic.Exists(tmp) Then
            Dic.Add tmp, Array(Darr(i, 5), i)
        ElseIf Darr(i, 5) >= Dic.Item(tmp)(0) Then
            If Rng Is Nothing Then
                Set Rng = Range("A" & Dic.Item(tmp)(1))
            Else
                Set Rng = Union(Rng, Range("A" & Dic.Item(tmp)(1)))
            End If
            Dic.Item(tmp) = Array(Darr(i, 5), i)
        End If
    End If
Next i
Rng.Select
Selection.EntireRow.Delete
Range("A1").Select
Set Dic = Nothing:  Set Rng = Nothing:  Erase Darr
Application.ScreenUpdating = True
End Sub