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

Liên hệ QC

Người dùng đang xem chủ đề này

van_thanh_phong

Thành viên chính thức
Tham gia
25/6/08
Bài viết
87
Được thích
10
Nghề nghiệp
Giáo viên
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 !
 

File đính kèm

Lần chỉnh sửa cuối:
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 !

 
Upvote 0
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("A
5:A65536"), Range("A" & i)) > 1 Then
Range
("A" & i & ":P" & 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...
 
Upvote 0
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.
PHP:
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é !
 
Upvote 0
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("A
5:A65536"), Range("A" & i)) > 1 Then
Range
("A" & i & ":P" & 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
 
Upvote 0
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.
 
Upvote 0
... 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.
 
Lần chỉnh sửa cuối:
Upvote 0
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 ạ !
 
Upvote 0
Đó 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
PHP:
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
 
Upvote 0
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
 
Lần chỉnh sửa cuối:
Upvote 0
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.
 
Upvote 0
Cái này viết tương tự như gợi ý của bài 26 nhưng không dùng Dic
PHP:
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é
 
Upvote 0
Web KT

Bài viết mới nhất

Back
Top Bottom