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!!!

 

[van_thanh_phong]

Còn vấn đề nữa mình đang phân vân:
Đoạn code:

For i = 5 To Range("B65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf(Range("B5:B65536"), Range("B" & i)) > 1 Then
Range("A" & i & ":O" & i).ClearContents
End If
Next

chỉ kiểm tra cột B là tên có trùng thì xóa nội dung của vùng dữ liệu đó, nhưng nếu tên trùng mà các cột khác không trùng thì sao ?
Vẫn có trường hợp đó xảy ra.
Ví dụ: tên giống nhau nhưng ngày tháng năm sinh khác nhau thì sao?
Như vậy làm thế nào kiểm tra tất cả các cột của dòng ( trừ cột STT). Nếu giống nhau hoàn toàn thì mới xóa, nếu có một cột khác nhau thì không xóa !

 

[nmhung49]

Còn vấn đề nữa mình đang phân vân:
Đoạn code:

For i = 5 To Range("B65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf(Range("B5:B65536"), Range("B" & i)) > 1 Then
Range("A" & i & ":O" & i).ClearContents
End If
Next

chỉ kiểm tra cột B là tên có trùng thì xóa nội dung của vùng dữ liệu đó, nhưng nếu tên trùng mà các cột khác không trùng thì sao ?
Vẫn có trường hợp đó xảy ra.
Ví dụ: tên giống nhau nhưng ngày tháng năm sinh khác nhau thì sao?
Như vậy làm thế nào kiểm tra tất cả các cột của dòng ( trừ cột STT). Nếu giống nhau hoàn toàn thì mới xóa, nếu có một cột khác nhau thì không xóa !

CHèn thêm cột phụ rồi dùng công thức nói các ô lại với nhau rồi dùng code trên để kiểm tra thế là xong
Chẳng hạn Insert thêm cột A
Ở ô A5
=C5&D5&E5&F5&G5&H5&I5&J5&K5&L5&M5&N5&O5&P5
Kéo xuống rồi dùng code
For i = 5 To Range("A65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf(Range("A5:A65536"), Range("A" & i)) > 1 Then
Range("A" & i & "" & i).ClearContents
End If
Next


Đó là một cách cách khác là dùng Advanfilter, Remove Dup, Hoặc dùng Dictionary v..v...

 

[van_thanh_phong]

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

Hi.......... ! Thuật toán bạn dùng mình hiểu không tới, và sửa lại tý cho hợp với dữ liệu của mình là OK, Code của bạn thực hiện tốt yêu cầu xóa dữ liệu trùng.
Cảm ơn nhé !

 

[van_thanh_phong]

CHèn thêm cột phụ rồi dùng công thức nói các ô lại với nhau rồi dùng code trên để kiểm tra thế là xong
Chẳng hạn Insert thêm cột A
Ở ô A5
=C5&D5&E5&F5&G5&H5&I5&J5&K5&L5&M5&N5&O5&P5
Kéo xuống rồi dùng code
For i = 5 To Range("A65536").End(xlUp).Row
If Application.WorksheetFunction.CountIf(Range("A5:A65536"), Range("A" & i)) > 1 Then
Range("A" & i & "" & i).ClearContents
End If
Next


Đó là một cách cách khác là dùng Advanfilter, Remove Dup, Hoặc dùng Dictionary v..v...

Đó cũng là một cách !
Nhưng mình muốn học thêm cách xóa dữ liệu trùng mà không dùng cột phụ hay công thức chỉ dùng VBE thôi

 

[khuongvietphong]

xoá dữ liệu trùng nhau trong excel

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.

Em tưởng trong excel có hẳn chức năng remove Duplicates để phục vụ công việc này, hay trong bài này không dùng được chức năng đó hay sao mà anh lại phải dùng cách có thể gọi là hơi mất công này.

 

[VetMini]

... mình muốn học thêm cách xóa dữ liệu trùng mà không dùng cột phụ hay công thức chỉ dùng VBE thôi

Muốn học thì tôi mách cho giải thuật, không viết code mệt lắm.

1. Tạo một dictionary DIC
2. Đọc dữ liệu từ đầu đến cuối. Mỗi dòng, dùng hàm Join và Application.Transpose để ghép dữ liệu trong dòng thành một chuõi CHUOI
3. Dò CHUOI trong DIC, nếu có rồi thì delete dòng, nếu chưa có thì ghi CHUOI của dữ liệu vào DIC

Đây là giải thuật tổng quát. Ở bước số 2 có thể tuỳ thích sửa lại như thế nào để so sánh dữ liệu lặp lại. Các bước khác có thể giữ y.

 

[van_thanh_phong]

Em tưởng trong excel có hẳn chức năng remove Duplicates để phục vụ công việc này, hay trong bài này không dùng được chức năng đó hay sao mà anh lại phải dùng cách có thể gọi là hơi mất công này.

Chức năng remove Duplicates có trong phiên bản 2007 trở đi. Còn mình đang dùng phiên bản off 2003 nên không có bạn ạ !

 

[gtri]

Đó cũng là một cách !
Nhưng mình muốn học thêm cách xóa dữ liệu trùng mà không dùng cột phụ hay công thức chỉ dùng VBE thôi

Cái này viết tương tự như gợi ý của bài 26 nhưng không dùng Dic

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)    'Khai báo mảng SoSanh, số phần tử bằng số dòng của DL

For d = 1 To DL.Rows.Count
For c = 2 To DL.Columns.Count
SoSanh(d) = SoSanh(d) & DL(d, c)   'Nạp mảng SoSanh, mỗi phần tử là Join 1 dòng của DL từ cột 2 tới cột cuối
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        'Kiểm tra mảng SoSanh, nếu phần tử nào trùng thì xóa cả dòng DL
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

 

[nthumai2000]

Chào các bạn,

Cho mình hỏi nếu mình muốn xóa mất luôn cặp dữ liệu xuất hiện trùng thì phải làm thế nào a.

vd dụ : mình có 3 mã hàng hóa với cột số tiền giống nhau :

A : 30.000
A : -30.000
A : 50.000

Mình cần xóa cặp dữ liệu hàng hóa A số tiền : 30.000 & -30.000, giữ lại dòng A : 50.000

Nhờ các bạn giúp mình code này với

Cám ơn các bạn nhiều


Mai

 

[chisinhvnn]

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é

Nhờ GPE giải thích cho mình đoạn code trên giúp mình với.

 

[nthumai2000]

Cái này viết tương tự như gợi ý của bài 26 nhưng không dùng Dic

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)    'Khai báo mảng SoSanh, số phần tử bằng số dòng của DL

For d = 1 To DL.Rows.Count
For c = 2 To DL.Columns.Count
SoSanh(d) = SoSanh(d) & DL(d, c)   'Nạp mảng SoSanh, mỗi phần tử là Join 1 dòng của DL từ cột 2 tới cột cuối
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        'Kiểm tra mảng SoSanh, nếu phần tử nào trùng thì xóa cả dòng DL
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

Rất cảm ơn bạn ah, lâu quá mình không vào GPE nên không thấy bài reply của bạn, cảm ơn bạn nhiều nhé