Xin trợ giúp xoá dữ liệu trùng trong excel bằng VBA (1 người xem)

[van_thanh_phong]

Làm mãi không xong, tìm mãi không thấy nên mới tạo chủ đề, mong các bạn giúp đỡ !
Mình xin trình bày như sau:Có nhiều dòng mà các cột có nội dung hoàn toàn giồng nhau, ( do copy nhầm ), không tính cột STT.
Làm thế nào để xóa nhiều dòng giống nhau chỉ chừa một dòng.
Ví dụ: có 3 dòng giống nhau thì xóa 2 dòng và chừa lại một dòng.
Xem dữ liệu trong file đính kèm nhé
Chân thành cảm ơn !

 

[vu_tuan_manh_linh]

VBA làm gì cho rắc rối hả bạn!! Làm thế này đi
1. Copy vùng dữ liệu A5:O21 và paste sang 1 sheet khác
2. Tại sheet mới vừa paste, đặt hàm tại P1=IF(COUNTIF($B$1:B1;B1)=1;1;""), sau đó fill đến hết dòng.
3. Copy cột P và paste value tại chính cột P luôn.
4. Chọn toàn bộ cột P và sort A->Z.
5. Tại cột P, những dòng nào có số 1 thì giữ lại, từ dòng nào trống thì xóa đến hết luôn.
Làm như thế thì sau này có trùng dữ liệu kiểu gì bạn cũng lọc được, chứ viết code cho bạn thì lần sau bạn cũng bó tay luôn.

 

[Cá ngừ F1]

Tôi record marco được code Remove duplicate này, thấy chạy tốt, bạn tham khảo:
[GPECODE=vb]Private Sub CommandButton1_Click()
ActiveSheet.Range("$B$4:$O$21").RemoveDuplicates Columns:=Array(1, 2, 3, 4, 5, 6, 7 _
, 8, 9, 10, 11, 12, 13, 14), Header:=xlYes
End Sub[/GPECODE]

 

[van_thanh_phong]

Khi mình chạy trong file thì bị báo lỗi ! Bạn chạy thử và sửa lỗi dùm nhé Cá Ngừ F1
Cảm ơn nhiều !

 

[Cá ngừ F1]

Khi mình chạy trong file thì bị báo lỗi ! Bạn chạy thử và sửa lỗi dùm nhé Cá Ngừ F1
Cảm ơn nhiều !

Mình vừa chạy thử, không thấy lỗi gì, tuy nhiên, cho hỏi bạn dùng bản off bao nhiêu, từ 2007 trở lên mới có Data/Remove Duplicate.

 

[van_thanh_phong]

Mình đang chập chững vào VBA nên muốn học tí ấy mà !
Mong được các bạn trong GPE giúp đỡ !

 

[van_thanh_phong]

Hix.......... mình dùng 2003 !
Bạn viết trên 2003 dùm nhé! Nó báo lỗi 438 !

 

[Cá ngừ F1]

Hix.......... mình dùng 2003 !
Bạn viết trên 2003 dùm nhé! Nó báo lỗi 438 !

Thế bạn dùng chức năng Advance Filter nhé
[GPECODE=vb]Sub XoaTrung()
With Sheet1
.Rows("5:1000").Clear
Sheets("DSHS").Range("B4:O65536").AdvancedFilter 2, .[F1:F2], .[B4:O4], 1
If .[B5] <> "" Then Range(.[B5], .[B65536].End(3)).Offset(, -1) = .[row(a:a)]
.[A4].CurrentRegion.Borders.Value = 1
End With
End Sub[/GPECODE]
Sheet DSHS là cơ sở dữ liệu không nên đụng vào, nên tôi làm 1 sheet mới, dữ liệu sẽ copy sang sheet đó và loại bỏ những dữ liệu trùng.
Mở file, click RUN, Bạn tham khảo nhé

 

[van_thanh_phong]

Công thức thì mình cũng tàm tạm được nhưng ý mình là muốn dùng VBA cơ. Vì công thức làm nặng file.
Bạn xem rồi góp ý dùm nhé bạn vu_tuan_manh_linh (không cần sort)
Cảm ơn bạn đã chia sẽ !

 

[vu_tuan_manh_linh]

Công thức thì mình cũng tàm tạm được nhưng ý mình là muốn dùng VBA cơ. Vì công thức làm nặng file.
Bạn xem rồi góp ý dùm nhé bạn vu_tuan_manh_linh (không cần sort)
Cảm ơn bạn đã chia sẽ !

Ý của tôi là sau khi lọc được rồi thì đưa dữ liệu vào file mới luôn, bỏ file gốc đi, lúc ấy hết công thức rồi còn nặng gì nữa. File bạn gửi chi cần fillter, sau đó copy và paste sang file mới thôi!!! Làm như thế cũng đâu có chậm chạp gì, mà bạn chủ động hoàn toàn về thao tác và dữ liệu. Chứ làm code lỡ có sai sót một chút thì hỏng ăn!!!
Nếu bạn vẫn muốn code thì mình có giải pháp này dễ hiểu:
- Truy tìm những dòng trùng dữ liệu rồi xóa toàn bộ dữ liệu của dòng trùng
- Sort để sắp xếp các dòng còn lại.

Sub LOC()
Dim i
Application.ScreenUpdating = False
For i = 1 To Range("B65536").End(xlUp).Row
    If Application.WorksheetFunction.CountIf(Range("B1:B65536"), Range("B" & i)) > 1 Then
        Range("A" & i & ":O" & i).ClearContents
    End If
Next
Range("A1:O17").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Rows(Range("B65536").End(xlUp).Row + 1 & ":65536").Delete
Application.ScreenUpdating = True
End Sub

 

[quocphuoc88]

Thử xem ok chưa bạn !

Sub GPE_XoaDL()
Dim Endr As Long, i As Long, j As Long, Tmp As String, Sarr(), Dic As Object, Arr() As Long
Application.ScreenUpdating = False
With Sheet1
    If .AutoFilterMode Then .AutoFilterMode = False 'tat che do autofilter
    Endr = .Range("C65500").End(xlUp).Row
    If Endr > 1 Then
        Sarr = .Range("A2:P" & Endr)
        Set Dic = CreateObject("Scripting.Dictionary")
        For i = 1 To Endr - 1
            Tmp = UCase(Trim(Sarr(i, 3))) 'chuyen doi cho no trung
            If Not Dic.Exists(Tmp) Then
                Dic.Add Tmp, ""
            Else
                j = j + 1
                ReDim Preserve Arr(1 To j)
                Arr(j) = i
            End If
        Next i
        If j Then
            For i = j To 1 Step -1
                .Cells(Arr(i) + 1, 1).EntireRow.Delete
            Next i
        End If
        Set Dic = Nothing
    End If
End With
Application.ScreenUpdating = True
End Sub

 

[gtri]

Góp vui thêm đoạn nữa, nếu nhỡ bị trùng tên nhưng khác địa chỉ thì vẫn không bị xóa.

Public Sub LocDanhSach()
Dim DL, SoSanh(), d As Long, r As Long, c As Long

Application.ScreenUpdating = False
Set DL = Sheet1.UsedRange
ReDim SoSanh(1 To DL.Rows.Count)

For d = 1 To DL.Rows.Count
For c = 2 To DL.Columns.Count
SoSanh(d) = SoSanh(d) & DL(d, c)
Next c
Next d

For d = DL.Rows.Count To 3 Step -1
For r = d - 1 To 2 Step -1
If SoSanh(d) = SoSanh(r) Then
DL.Rows(r).Delete
End If
Next r
Next d

Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)) = "=row()-1"
Application.ScreenUpdating = True
End Sub

 

[vu_tuan_manh_linh]

Góp vui thêm đoạn nữa, nếu nhỡ bị trùng tên nhưng khác địa chỉ thì vẫn không bị xóa.

Public Sub LocDanhSach()
Dim DL, SoSanh(), d As Long, r As Long, c As Long

Application.ScreenUpdating = False
Set DL = Sheet1.UsedRange
ReDim SoSanh(1 To DL.Rows.Count)

For d = 1 To DL.Rows.Count
For c = 2 To DL.Columns.Count
SoSanh(d) = SoSanh(d) & DL(d, c)
Next c
Next d

For d = DL.Rows.Count To 3 Step -1
For r = d - 1 To 2 Step -1
If SoSanh(d) = SoSanh(r) Then
DL.Rows(r).Delete
End If
Next r
Next d

Sheet1.Range("A2", Sheet1.Range("A2").End(xlDown)) = "=row()-1"
Application.ScreenUpdating = True
End Sub

Giải pháp này của bạn rất chậm vì 2 vòng lặp lồng nhau và thủ tục xóa dòng.

 

[gtri]

Giải pháp này của bạn rất chậm vì 2 vòng lặp lồng nhau và thủ tục xóa dòng.

Chủ thớt muốn tham khảo về VBA nên viết thêm cho xôm tụ, còn chậm thì là chắc rồi.

 

[van_thanh_phong]

Xin cảm ơn tất cả các bạn trong GPE nhé!
Mình rất vui vì được sự giúp đỡ nhiệt tình của các bạn !

 

[van_thanh_phong]

Ý của tôi là sau khi lọc được rồi thì đưa dữ liệu vào file mới luôn, bỏ file gốc đi, lúc ấy hết công thức rồi còn nặng gì nữa. File bạn gửi chi cần fillter, sau đó copy và paste sang file mới thôi!!! Làm như thế cũng đâu có chậm chạp gì, mà bạn chủ động hoàn toàn về thao tác và dữ liệu. Chứ làm code lỡ có sai sót một chút thì hỏng ăn!!!
Nếu bạn vẫn muốn code thì mình có giải pháp này dễ hiểu:
- Truy tìm những dòng trùng dữ liệu rồi xóa toàn bộ dữ liệu của dòng trùng
- Sort để sắp xếp các dòng còn lại.

Sub LOC()
Dim i
Application.ScreenUpdating = False
For i = 1 To Range("B65536").End(xlUp).Row
    If Application.WorksheetFunction.CountIf(Range("B1:B65536"), Range("B" & i)) > 1 Then
        Range("A" & i & ":O" & i).ClearContents
    End If
Next
Range("A1:O17").Sort Key1:=Range("A1"), Order1:=xlAscending, Header:= _
        xlGuess, OrderCustom:=1, MatchCase:=False, Orientation:=xlTopToBottom, _
        DataOption1:=xlSortNormal
Rows(Range("B65536").End(xlUp).Row + 1 & ":65536").Delete
Application.ScreenUpdating = True
End Sub

Giải pháp của bạn Vu_Tuan_Manh_Linh rất dễ hiểu.
Với những người mò mẫm như mình thì đây là một giải pháp tuyệt vời !
Song,mình vẫn không hiểu đoạn này:
Range("A1:O17").....
Nếu dữ liệu sau khi đã xóa chưa biết bao nhiêu dòng thì sao ?

 

[Cá ngừ F1]

Giải pháp của bạn Vu_Tuan_Manh_Linh rất dễ hiểu.
Với những người mò mẫm như mình thì đây là một giải pháp tuyệt vời !
Song,mình vẫn không hiểu đoạn này:
Range("A1:O17").....
Nếu dữ liệu sau khi đã xóa chưa biết bao nhiêu dòng thì sao ?

Bài này có nhiều giải pháp cho bạn:
- c1: phương thức remove duplicate như đã trình bầy. Với cách này bạn nên update lên phiên bản office mới, dù sao phiên bản 2003 đã cách đây 10 năm rùi.
- c2: đung advance filter với điều kiện để trống và tích chọn unique record
Các phương thức sẵn có của Excel thường là tối ưu.
Chúc bạn thành công!

 

[vu_tuan_manh_linh]

Giải pháp của bạn Vu_Tuan_Manh_Linh rất dễ hiểu.
Với những người mò mẫm như mình thì đây là một giải pháp tuyệt vời !
Song,mình vẫn không hiểu đoạn này:
Range("A1:O17").....
Nếu dữ liệu sau khi đã xóa chưa biết bao nhiêu dòng thì sao ?

Sorry bạn, đoạn code được record nên mình chưa sửa lại. Bạn thay đoạn code Range("A1:O17") bằng đoạn sau: Range("A1:O"&range("B65536").End(XlUp).Row)

 

[van_thanh_phong]

Mình rất cảm ơn bạn Vu_tuan_manh_linh đã chỉ giúp, Mình đã hiểu rồi !
Mình nghỉ với dữ liệu của mình, mình nên sửa lại tý:
For i = 5 To....
và
Range("A5:O" & Range("B65536")......
Vì mình duyệt từ dòng 5 trở đi, không biết mình hiểu vậy có sai không ?

 

[vu_tuan_manh_linh]

Mình rất cảm ơn bạn Vu_tuan_manh_linh đã chỉ giúp, Mình đã hiểu rồi !
Mình nghỉ với dữ liệu của mình, mình nên sửa lại tý:
For i = 5 To....
và
Range("A5:O" & Range("B65536")......
Vì mình duyệt từ dòng 5 trở đi, không biết mình hiểu vậy có sai không ?

Như thế là bạn đã hiểu vấn đề rồi!!!