Xóa toàn bộ các dòng giống nhau ở 1 cột (1 người xem)

[hadoan-pap]

Kính gửi mọi người.

Em có 1 file dữ liệu rất nhiều dòng, em muốn kiểm tra và xóa đi các dòng mà có dữ liệu giống nhau ở cột A.

Dạ, em rất mong mọi người cho em xin đoạn code tương ứng với 3 trường hợp để em tham khảo ạ :

1. Xóa đi các dòng trùng nhưng giữ lại 1 dòng trên cùng
2. Xóa đi các dòng trùng nhưng giữ lại 1 dòng dưới cùng (dòng mới thêm vào)
3. Xóa toàn bộ không giữ lại dòng nào

Em xin chân thành cảm ơn!

 

[BuiQuangThuan]

Kính gửi mọi người.

Em có 1 file dữ liệu rất nhiều dòng, em muốn kiểm tra và xóa đi các dòng mà có dữ liệu giống nhau ở cột A.

Dạ, em rất mong mọi người cho em xin đoạn code tương ứng với 3 trường hợp để em tham khảo ạ :

1. Xóa đi các dòng trùng nhưng giữ lại 1 dòng trên cùng
2. Xóa đi các dòng trùng nhưng giữ lại 1 dòng dưới cùng (dòng mới thêm vào)
3. Xóa toàn bộ không giữ lại dòng nào

Em xin chân thành cảm ơn!

Cai này dùng chức năng Remove Duplicates hoặc lọc cũng được mà

 

[hadoan-pap]

Cai này dùng chức năng Remove Duplicates hoặc lọc cũng được mà

Dạ, em thấy remove duplicate nó giữ lại dòng trên và xóa các dòng dưới.

Trong trường hợp muốn xóa các dòng trên (giữ dòng dưới), hoặc xóa toàn bộ các dòng đi thì hình như không được ạ

 

[BuiQuangThuan]

Dạ, em thấy remove duplicate nó giữ lại dòng trên và xóa các dòng dưới.

Trong trường hợp muốn xóa các dòng trên (giữ dòng dưới), hoặc xóa toàn bộ các dòng đi thì hình như không được ạ

Thì có nói thêm với bạn sử dụng thêm cách là lọc nữa mà

 

[hadoan-pap]

Thì có nói thêm với bạn sử dụng thêm cách là lọc nữa mà

Dạ, anh có thể cho e xin 3 đoạn code tương ứng với 3 trường hợp được không ạ ?

Vì em chạy tự động nên dùng các tính năng của excel cũng không đúng với cái em hướng tới ạ

Em xin cảm ơn ạ!

 

[BuiQuangThuan]

Dạ, anh có thể cho e xin 3 đoạn code tương ứng với 3 trường hợp được không ạ ?

Vì em chạy tự động nên dùng các tính năng của excel cũng không đúng với cái em hướng tới ạ

Em xin cảm ơn ạ!

Nếu không có data cụ thể. khó lòng mà code theo kiểu bạn mong muốn được. Khó kiểm soát lỗi

 

[Hoàng Tuấn 868]

Nếu không có data cụ thể. khó lòng mà code theo kiểu bạn mong muốn được. Khó kiểm soát lỗi

Chán nhất mấy vụ cần có file để xem định dạng cụ thể còn làm cho nhanh thì cứ ỳ ra, không chịu đưa lên.

 

[VetMini]

Chán nhất mấy vụ cần có file để xem định dạng cụ thể còn làm cho nhanh thì cứ ỳ ra, không chịu đưa lên.

Làm quái gì có file sẵn. Người ta chỉ cần code để tham khảo (không chừng còn được bảng đánh giá "tối ưu" nữa) chứ có để làm việc đâu.
Dữ liệu chắc chờ bạn nào hăng hái cần test code thì dựng giùm may ra còn xài được. Tự dựng có khả năng rác 90%.

 

[hadoan-pap]

Nếu không có data cụ thể. khó lòng mà code theo kiểu bạn mong muốn được. Khó kiểm soát lỗi

Dạ em gửi file mô tả ví dụ như đính kèm ạ.

File này sẽ dựa trên cột A để xác định dòng trùng nhau ạ.

Em xin cảm ơn!

Bài đã được tự động gộp: 2/11/24

Làm quái gì có file sẵn. Người ta chỉ cần code để tham khảo (không chừng còn được bảng đánh giá "tối ưu" nữa) chứ có để làm việc đâu.
Dữ liệu chắc chờ bạn nào hăng hái cần test code thì dựng giùm may ra còn xài được. Tự dựng có khả năng rác 90%.

Dạ cũng gần như anh nói ạ, vì file thực tế của em nó đa dạng và nhiều dữ liệu lắm ạ. Nên em cũng có làm mẫu 1 file để em xin code tham khảo và em sẽ dựa vào thực tế bài toán của em để em điều chỉnh ạ.

Em cảm ơn anh!

 

[bebo021999]

Xin luôn 3 code cho 3 trường hợp, quả là cao thủ!
Các bác vào khỏi có ý kiến ý cò gì về vụ phát sinh thêm này nọ nữa nhé.

 

[bebo021999]

Mình góp ý là không nên dùng 3 nút bấm cho 3 trường hợp, nhìn rườm rà lắm.
Mình đề xuất dùng 1 nút thôi, cho phép chọn phương án 1 hay 2 hay 3.
Sau khi bạn test nếu chọn 1 trường hợp thôi thì vào code sửa lại (cũng đơn giản thôi, nếu bạn hiểu cách hoạt động của code. Bạn có thể paste vào ChatGPT nó sẽ giải thích cho bạn và tùy biến cho bạn)

Option Explicit
Sub xoadong()
Dim i&, rng, U As Range, st As String
Dim dic As Object, key, ip, s
Set dic = CreateObject("Scripting.Dictionary")
rng = Range("A2:A" & Cells(Rows.Count, "A").End(xlUp).Row).Value
For i = 1 To UBound(rng)
    If Not dic.exists(rng(i, 1)) Then
        dic.Add rng(i, 1), i + 1
    Else
        dic(rng(i, 1)) = dic(rng(i, 1)) & "|" & i + 1
    End If
Next

'Doan nay co the bo di neu ban khong dung inputbox
ip = InputBox("Xoa dong: (Chon 1, 2 hoac 3):" & vbLf & _
"1. Giu lai dong dau tien" & vbLf & _
"2. Xoa tat ca" & vbLf & _
"3. Giu lai dong cuoi cung", " Ban muon xoa cac dong trung?", 1)

For Each key In dic.keys
    If Not IsNumeric(dic(key)) Then
        s = Split(dic(key), "|")
        For i = 0 To UBound(s)
            If (ip = 1 And i > 0) Or (ip = 2) Or (ip = 3 And i < UBound(s)) Then ' Neu chi can 1 chon lua thi xoa bot OR di
                If U Is Nothing Then
                    Set U = Cells(s(i), 1)
                Else
                    Set U = Union(U, Cells(s(i), 1))
                End If
            End If
        Next
    End If
Next
Set dic = Nothing
If Not U Is Nothing Then U.EntireRow.Select
If MsgBox("Ban chuan bi xoa cac dong duoc chon! Nhan Yes de xoa hay No de huy xoa.", vbYesNo) = vbNo Then Exit Sub 'Xoa dong nay neu khong muon confirm
Selection.Delete
Range("A1").Select
End Sub

 

[SA_DQ]

Chủ bài đăng thử con macro này & xem kết quả có thỏa 1 trong ba trường hợp chưa nha:

Sub XoaDongTrung_f()
 Dim Rws As Long, J As Long, W As Integer
 Dim Rng As Range, sRng As Range, dRg As Range
 Dim MaHH As String, MyAdd As String
 
 Rws = [A2].End(xlDown).Row
 For J = 2 To Rws - 1
    MaHH = Cells(J, "A").Value
    If MaHH = "" Then Exit For
    Set Rng = Cells(J + 1, "A").Resize(Cells(Rws + 9, "A").End(xlUp).Row)
    Set sRng = Rng.Find(MaHH, , xlFormulas, xlWhole)
    If Not sRng Is Nothing Then
        MyAdd = sRng.Address
        Do
            If dRg Is Nothing Then
                Set dRg = Rows(sRng.Row & ":" & sRng.Row)
            Else
                Set dRg = Union(dRg, Rows(sRng.Row & ":" & sRng.Row))
            End If
            Set sRng = Rng.FindNext(sRng)
        Loop While Not sRng Is Nothing And sRng.Address <> MyAdd
    End If
    If Not dRg Is Nothing Then
        Cells(J, "A").Interior.ColorIndex = 34 + J Mod 10
        dRg.Delete:             Set dRg = Nothing
        MsgBox "Xem"
    End If
 Next J
End Sub

 

[hadoan-pap]

Em xin cảm ơn nhiều ạ, em sẽ tham khảo để có thể chỉnh sửa và áp dụng vào bài toán của mình ạ.

 

[SA_DQ]

. . . . . em sẽ tham khảo để có thể chỉnh sửa và áp dụng vào bài toán của mình ạ.

Xin lưu ý 1 số điểm sau:
(1) Macro ở #12 chỉ áp dụng đúng cho dữ liệu cột 'A' ngoài kiểu ngày-tháng-năm; khi đó phương thức FIND() sẽ viết khác đôi chút;
(2) Để xóa dòng trùng & để lại dòng cuối thì vòng lặp phải đi theo hướng ngược lại
(3) Muốn xóa tất cả các dòng trùng thì . . . .