Nhờ viết code xóa dữ liệu trùng lặp

[duy_quang]

Kính nhờ Anh/chị giúp em xóa dữ liệu trùng lặp và đánh số thứ tự tự động sau mỗi lần xóa dữ liệu trùng lặp. (theo file đính kèm)
em trân trọng cảm ơn Anh/chị.

 

[VetMini]

...

Nếu muốn duyệt từ dưới lên thì phải quy định rõ: Bảng dữ liệu đã được sắp xếp (chí ít là phải ghi quy ước như vậy, và yêu cầu trước khi chạy code phải thao tác sắp xếp bảng dữ liệu). Hoặc trong code phải có phần sắp xếp đó.
...

Đít sần vốn không lý đến thứ tự.
Đã dùng đít sần thì tránh chớ có lẫn nó vào các thuật toán liên quan đến thứ tự. Trừ một số ít trường hợp hết sức đặc thù.

...
Chỉ cần 1 lần xét các phần tử là được, đã nêu ở bài #3 đó.

Kỹ thuật chọn cái gần/xa nhất như vầy là chính xác.

 

[BuiQuangThuan]

Thử viết lại chỉ 1 vòng For i

Hihi. Có vẻ như vầy sẽ gọn gàng hơn.
Cám ơn thầy đã gợi ý ạ

Sub ABC()
    Dim sArr(), Dic As Object, i&, K&, Res()
    Set Dic = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    With Sheets("data")
        sArr = .Range("A4:C" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr, 1), 1 To 3)
        For i = UBound(sArr, 1) To 1 Step -1
            If Dic.exists(UCase(sArr(i, 3))) = False Then
                Dic.Item(UCase(sArr(i, 3))) = i
                    K = K + 1
                    Res(K, 2) = sArr(i, 2)
                    Res(K, 3) = sArr(i, 3)
            End If
        Next
        .Range("A4:C1000").ClearContents
        .Range("A4").Resize(K, 3).Value = Res
        .Range("A4").Resize(K, 3).Sort .Range("B3"), xlAscending
        .Range("A4").Value = 1
        .Range("A4").AutoFill .Range("A4").Resize(K), xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub

 

[HieuCD]

Hihi. Có vẻ như vầy sẽ gọn gàng hơn.
Cám ơn thầy đã gợi ý ạ

Sub ABC()
    Dim sArr(), Dic As Object, i&, K&, Res()
    Set Dic = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    With Sheets("data")
        sArr = .Range("A4:C" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr, 1), 1 To 3)
        For i = UBound(sArr, 1) To 1 Step -1
            If Dic.exists(UCase(sArr(i, 3))) = False Then
                Dic.Item(UCase(sArr(i, 3))) = i
                    K = K + 1
                    Res(K, 2) = sArr(i, 2)
                    Res(K, 3) = sArr(i, 3)
            End If
        Next
        .Range("A4:C1000").ClearContents
        .Range("A4").Resize(K, 3).Value = Res
        .Range("A4").Resize(K, 3).Sort .Range("B3"), xlAscending
        .Range("A4").Value = 1
        .Range("A4").AutoFill .Range("A4").Resize(K), xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub

Cần xét ngày tháng để lấy dòng có ngày mới nhất

 

[BuiQuangThuan]

Cần xét ngày tháng để lấy dòng có ngày mới nhất

Hinh như cái vụ ngày mới nhất nó không có liên quan tới yêu cầu của chủ thớt thầyạ

 

[HieuCD]

View attachment 271312Hinh như cái vụ ngày mới nhất nó không có liên quan tới yêu cầu của chủ thớt thầyạ

Hinh như cái vụ ngày mới nhất nó không có liên quan tới yêu cầu của chủ thớt thầyạ

Mình không để ý, Hì hì
Thay tí để xếp thứ tự

Sub ABC()
    Dim sArr(), Dic As Object, i&, K&, Res()
    Set Dic = CreateObject("scripting.dictionary")
    Application.ScreenUpdating = False
    With Sheets("data")
        sArr = .Range("A4:C" & .Range("B" & Rows.Count).End(3).Row).Value
        ReDim Res(1 To UBound(sArr, 1), 1 To 3)
        For i = UBound(sArr, 1) To 1 Step -1
            If Dic.exists(UCase(sArr(i, 3))) = False Then
                Dic.Item(UCase(sArr(i, 3))) = i
                    K = K + 1
                    Res(K, 1) = sArr(i, 1)
                    Res(K, 2) = sArr(i, 2)
                    Res(K, 3) = sArr(i, 3)
            End If
        Next
        .Range("A4:C1000").ClearContents
        .Range("A4").Resize(K, 3).Value = Res
        .Range("A4").Resize(K, 3).Sort .Range("A3"), xlAscending
        .Range("A4").Value = 1
        .Range("A4").AutoFill .Range("A4").Resize(K), xlFillSeries
    End With
    Application.ScreenUpdating = True
End Sub

 

[BuiQuangThuan]

Res(K, 1) = sArr(i, 1)

Thầy. Cái đoạn này mà để vào mảng kết quả. thì khi sort nó không theo thứ tự và cũng không theo seri thầy ạ
Và em không biết điền thế nào để số thứ tự tăng dần đành phải thêm đoạn này

.Range("A4").AutoFill .Range("A4").Resize(K), xlFillSeries

 

[HieuCD]

Thầy. Cái đoạn này mà để vào mảng kết quả. thì khi sort nó không theo thứ tự và cũng không theo seri thầy ạ
Và em không biết điền thế nào để số thứ tự tăng dần đành phải thêm đoạn này

.Range("A4").AutoFill .Range("A4").Resize(K), xlFillSeries

Res(K, 1) = sArr(i, 1)
....
.Range("A4").Resize(K, 3).Value = Res
.Range("A4").Resize(K, 3).Sort .Range("A3"), xlAscending
Nhằm giữ nguyên thứ tự gốc