- Kỹ thuật xóa dữ liệu trùng của các ô, code cực ngắn - có thể làm thành Add-In

Liên hệ QC
dmtdmtbb

dmtdmtbb

Biệt danh: xDelx
Tham gia
24/5/07
Bài viết
306
Được thích
438
- Xáa dữ liệu trùng của ô được quét khối, chỉ tính theo dòng, cột không quá 1.
- Bác nào có cách ngắn hơn chia sẽ nhé !
Mã: 
Sub DelDupCells()
On Error Resume Next
Application.ScreenUpdating = False
Dim i, x
  If Selection.Columns.Count > 1 Then MsgBox "Khong duoc chon qua 2 cot.", 16, "Msg": Exit Sub
  If Selection.Rows.Count < 2 Then MsgBox "Cot can xoa it nhat la 2.", 48, "Msg": Exit Sub
  If MsgBox("Ban co chac muon xoa ?", vbQuestion + vbYesNo, "Msg") = vbNo Then Exit Sub
  For i = Selection.Rows.Count To 1 Step -1
      x = Selection.Cells(i, 1).Value
      If Application.CountIf(Selection, x) > 1 Then
         Selection(i).ClearContents
      End If
  Next
End Sub
 
Lần chỉnh sửa cuối:
Cái này vẫn chậm hơn AF, unique record only.
DMT xem thêm giải thuật bỏ dòng trống luôn. Sort rồi xóa hình như nhanh hơn xóa từ dưới lên.
 
Bác không loại dòng trống, em nhỡ tay chọn cả cột, chờ máy tính toán xong đến đuối mất. Bác sửa lại code cho anh em dùng nhé !
 
ThuNghi đã viết:
Cái này vẫn chậm hơn AF, unique record only.
DMT xem thêm giải thuật bỏ dòng trống luôn. Sort rồi xóa hình như nhanh hơn xóa từ dưới lên.
Nhấp chuột vào đây để mở rộng...

Hoặc chuyển nó thành 1 UF thì nhanh hơn nhiều bác ạ. Khi đó không quan trọng là bao nhiêu cột, bao nhiêu dòng nữa.

Thân!
 
Nguyên văn bởi dmtdmtbb
- Xáa dữ liệu trùng của ô được quét khối, chỉ tính theo dòng, cột không quá 1.
- Bác nào có cách ngắn hơn chia sẽ nhé !
Nhấp chuột vào đây để mở rộng...
Mình chỉ có cách dài hơn thôi.
Các bạn xem thử có cải thiện được tốc độ không?
Sub DelDupCells()
On Error Resume Next
Application.ScreenUpdating = False
Dim intCounter As Integer, intSecond As Integer, x As Integer, y As Integer, t As Integer, i As Integer
Dim rngData As Range
Set rngData = Selection
t = rngData.Row
x = rngData.Rows.Count
y = rngData.Column
i = rngData.Columns.Count
ReDim arrData(1 To x)
If i > 1 Then MsgBox "Khong duoc chon qua 2 cot.", 16, "Msg": Exit Sub
If x < 2 Then MsgBox "Cot can xoa it nhat la 2.", 48, "Msg": Exit Sub
If MsgBox("Ban co chac muon xoa ?", vbQuestion + vbYesNo, "Msg") = vbNo Then Exit Sub
For intCounter = 1 To x
arrData(intCounter) = Cells(t, y)
t = t + 1
Next intCounter
t = rngData.Row
For intCounter = 1 To x
intSecond = intCounter + 1
Do Until intSecond >= x + 1
If arrData(intCounter) = arrData(intSecond) Then
Cells(intSecond + t - 1, y).ClearContents
End If
intSecond = intSecond + 1
Loop
Next intCounter
Application.ScreenUpdating = True
End Sub
Nhấp chuột vào đây để mở rộng...
 
Hình như chỗ này có vấn đề bác ơi...Em vẫn chưa chọn được cả cột để thử

If i > 1 Then MsgBox "Khong duoc chon qua 2 cot.", 16, "Msg": Exit Sub
If x < 2 Then MsgBox "Cot can xoa it nhat la 2.", 48, "Msg": Exit Sub
 
Nguyên văn bởi phamnhukhang
Hình như chỗ này có vấn đề bác ơi...Em vẫn chưa chọn được cả cột để thử
Nhấp chuột vào đây để mở rộng...
Ngoài sự nhầm lẫn chữ dòng thành cột, nó có báo lỗi gì không? Bác test rồi cho biết cụ thể nhé!
 
voda đã viết:
Ngoài sự nhầm lẫn chữ dòng thành cột, nó có báo lỗi gì không? Bác test rồi cho biết cụ thể nhé!
Nhấp chuột vào đây để mở rộng...
Em đã Test nhưng Code vẫn chưa cho phép chon cả cột để làm việc. Theo em bác sửa lại như này thì tiện sử dụng hơn : Sau khi chay Macro, sẽ xuất hiện Textbox cho phép lựa chọn vùng làm việc.
 
Lần chỉnh sửa cuối:
- Khi chọn cả cột, muốn chạy code, phải khai báo lại biến x : dim x as Long.
-Tuy nhiên, chọn như thế thì số dòng quá lớn. Chương trình chạy rất lâu thậm chí làm cho máy đứng. Bạn có thể test với số dòng ít hơn ( dưới 1000 dòng).
 
Để tìm dữ liệu trùng, thay vì dùng vòng lặp để tìm dữ liệu trùng, ta dùng Find sẽ nhanh hơn.
Ví dụ dữ liệu có 1000 dòng. Ố A1 và ô A1000 trùng nhau, vòng lặp phải duyệt qua 999 ô mới phát hiện trùng, còn Find sẽ chỉ ngay ô A1000.
Mã: 
Sub XoaTrung()
rd = Selection.Row
rc = rd + Selection.Rows.Count - 1
c = Selection.Column
Range(Cells(rd, c), Cells(rc, c)).Select
rfind1 = rd
Do While rfind1 < rc
[COLOR=white]__[/COLOR]Range(Cells(rfind1, c), Cells(rc, c)).Select
[COLOR=white]__[/COLOR]dulieu = Cells(rfind1, c)
[COLOR=white]__[/COLOR]If dulieu = "" Then
[COLOR=white]____[/COLOR]rfind1 = Cells(rfind1, c).End(xlDown).Row
[COLOR=white]____[/COLOR]If rfind1 >= rc Then Exit Sub
[COLOR=white]__[/COLOR]Else
[COLOR=white]____[/COLOR]Do
[COLOR=white]______[/COLOR][COLOR=red][B]rfind2 = Selection.Find(What:=dulieu, After:=Cells(rfind1, c)).Row[/B][/COLOR]
[COLOR=white]______[/COLOR]If rfind2 > rfind1 Then
[COLOR=white]________[/COLOR]Cells(rfind2, c).EntireRow.Delete
[COLOR=white]________[/COLOR]rc = rc - 1
[COLOR=white]________[/COLOR]Range(Cells(rfind1, c), Cells(rc, c)).Select
[COLOR=white]______[/COLOR]Else
[COLOR=white]________[/COLOR]rfind1 = rfind1 + 1
[COLOR=white]________[/COLOR]Exit Do
[COLOR=white]______[/COLOR]End If
[COLOR=white]____[/COLOR]Loop
[COLOR=white]__[/COLOR]End If
Loop
End Sub

Sub XoaTrung có đặc điểm:
- Không giới hạn số cột trong vùng chọn, nhưng chỉ xét dữ liệu ở cột đầu tiên của vùng chọn ( biến c)
- Bỏ qua dữ liệu trống, do đó bạn chọn cả cột (65.536 dòng) cũng không ảnh hưởng đến tốc độ làm việc.
 

File đính kèm

  • XoaTrung.zip
    8.1 KB · Đọc: 181
Lần chỉnh sửa cuối:
Cám ơn Bác Long, giải pháp này quả là hay, nhưng hình như code chỉ làm việc tốt khi chọn cột đầu tiên, khi em chọn cột khác ngoài cột A thì báo lỗi " Run time error 91". Có bác nào test thử có bị như em không vây?
 
phamnhukhang đã viết:
Cám ơn Bác Long, giải pháp này quả là hay, nhưng hình như code chỉ làm việc tốt khi chọn cột đầu tiên, khi em chọn cột khác ngoài cột A thì báo lỗi " Run time error 91". Có bác nào test thử có bị như em không vây?
Nhấp chuột vào đây để mở rộng...
Xin lỗi các bạn. Do không test kỹ trước khi gởi nên có lỗi trong code. Các bạn tải lại XoaTrung.zip (tôi đã chỉnh lại).
Với bài toán này, tôi thấy nên giải quyết tiếp bước 2 với yêu cầu:
Thường dữ liệu của một mẫu tin (record) liên quan đến nhiều ô trên 1 dòng, nếu xét chỉ riêng 1 ô trùng, chưa chắc mẫu tin đã trùng.

Ví dụ một bảng dữ liệu có các trường STT, Họ tên, Nử, Ngày sinh, Nơi sinh. dữ liệu các mẫu tin như sau:
1, Trần Thanh Thơ, X, 24/05/1990, Đồng Tháp
2, Trần Thanh Thơ, , 20/03/1990, Cần Thơ
3, Nguyễn Văn Thơ, , 12/01/1991, Đồng Tháp
4, Trần Thanh Thơ, X, 24/05/1990, Đồng Tháp

- Nếu xét 1 trường Họ tên, mẫu tin 1, 2, 4 trùng.
- Nếu xét trường Nữ, mẫu tin 1, 4 trùng.
- Nếu xét trường Ngày sinh, mẫu tin 1, 4 trùng.
- Nếu xét trường Nơi sinh, mẫu tin 1, 3, 4 trùng.
- Nếu xét cả 4 trường Họ tên, ..., Nơi sinh, mẫu tin 1, 4 trùng. Đây mới chính là 2 mẫu tin trùng.
Do đó cần phải mở rộng bài toán sang xét tất cả các cột trong vùng dữ liệu. Nếu tất cả đều trùng mới xóa mẫu tin.
 
- Cám ơn thầy PDL, giải phám tìm kiếm Find, em đang tìm cách mở rộng thêm để làm thành Add-In, sử lý thêm một số tình huống khác.
 
Các bác giải quyết bài toán mở rộng do bác Pham Duy Long đặt ra đi. Em đang làm về số liệu nên rất cần công cụ này. Nhưng mà nếu các bác cho phép lọc ra những thông tin trùng trước khi xoá thì tốt vì nhiều khi cũng cần phải xem lại xem đối tượng bị trùng là những ai và đếm xem bao nhiêu đối tượng bị trùng. Các bác nếu cần file dữ liệu để test thì em sẵn sàng upload nên.
 
phamduylong đã viết:
Để tìm dữ liệu trùng, thay vì dùng vòng lặp để tìm dữ liệu trùng, ta dùng Find sẽ nhanh hơn.
Ví dụ dữ liệu có 1000 dòng. Ố A1 và ô A1000 trùng nhau, vòng lặp phải duyệt qua 999 ô mới phát hiện trùng, còn Find sẽ chỉ ngay ô A1000.
Mã: 
Sub XoaTrung()
rd = Selection.Row
rc = rd + Selection.Rows.Count - 1
c = Selection.Column
Range(Cells(rd, c), Cells(rc, c)).Select
rfind1 = rd
Do While rfind1 < rc
[COLOR=white]__[/COLOR]Range(Cells(rfind1, c), Cells(rc, c)).Select
[COLOR=white]__[/COLOR]dulieu = Cells(rfind1, c)
[COLOR=white]__[/COLOR]If dulieu = "" Then
[COLOR=white]____[/COLOR]rfind1 = Cells(rfind1, c).End(xlDown).Row
[COLOR=white]____[/COLOR]If rfind1 >= rc Then Exit Sub
[COLOR=white]__[/COLOR]Else
[COLOR=white]____[/COLOR]Do
[COLOR=white]______[/COLOR][COLOR=red][B]rfind2 = Selection.Find(What:=dulieu, After:=Cells(rfind1, c)).Row[/B][/COLOR]
[COLOR=white]______[/COLOR]If rfind2 > rfind1 Then
[COLOR=white]________[/COLOR]Cells(rfind2, c).EntireRow.Delete
[COLOR=white]________[/COLOR]rc = rc - 1
[COLOR=white]________[/COLOR]Range(Cells(rfind1, c), Cells(rc, c)).Select
[COLOR=white]______[/COLOR]Else
[COLOR=white]________[/COLOR]rfind1 = rfind1 + 1
[COLOR=white]________[/COLOR]Exit Do
[COLOR=white]______[/COLOR]End If
[COLOR=white]____[/COLOR]Loop
[COLOR=white]__[/COLOR]End If
Loop
End Sub

Sub XoaTrung có đặc điểm:
- Không giới hạn số cột trong vùng chọn, nhưng chỉ xét dữ liệu ở cột đầu tiên của vùng chọn ( biến c)
- Bỏ qua dữ liệu trống, do đó bạn chọn cả cột (65.536 dòng) cũng không ảnh hưởng đến tốc độ làm việc.
Nhấp chuột vào đây để mở rộng...

Nếu cột A tôi có:
1
10
100
101
300
201
301

Sau khi chạy thủ tục "Xoatrung" thì chỉ còn lại
1
300

Nếu đúng thì không xóa dòng nào cả vì các giá trị đều khác nhau.
Có lẽ không thể dùng Find được.

Nhân đây để tiện cho các bạn kiểm tra tốc độ tính toán, tôi giới thiệu các kiểm tra:

Ở đầu Module khai báo:
Mã: 
Public Declare Function GetTickCount Lib "kernel32" () As Long

Trong thủ tục làm như sau

Mã: 
Sub Xoatrung1()
    [COLOR="Blue"]'Đầu thủ tục gán[/COLOR]
    T1 = GetTickCount
     ....
     ....
     ....
     [COLOR="Blue"]Cuối thủ tục gán[/COLOR]
    T2 = GetTickCount
    [COLOR="Blue"]MsgBox (T2 - T1) / 1000, vbInformation, "Số giây là"[/COLOR]
End Sub

Với cách trên ta sẽ biết thủ tục hay hàm tiêu tốn hết bao nhiêu giây.
 
Lần chỉnh sửa cuối:
TuanVNUNI đã viết:
Ở đầu Module khai báo:
Mã: 
Public Declare Function GetTickCount Lib "kernel32" () As Long
.
Nhấp chuột vào đây để mở rộng...

Đây là những tuyệt chiêu của các cao thủ, mong bác Tuân có thể nói thêm về những điều này, VD ở topic : Các thủ thuật tăng tốc tính toán chẳng hạn.

Nếu bác đồng ý thì xin đãi bác 1 cốc sữa . . .dê chính hiệu Okebab

Thân!
 
TuanVNUNI đã viết:
Nếu cột A tôi có:
1
10
100
101
300
201
301
Sau khi chạy thủ tục "Xoatrung" thì chỉ còn lại
1
300
Nếu đúng thì không xóa dòng nào cả vì các giá trị đều khác nhau.
Có lẽ không thể dùng Find được.
Nhấp chuột vào đây để mở rộng...
Không có TuanVNUNI phát hiện, mình vẫn tưởng là đúng! Không phải tại Find mà do mình bỏ bớt một số Option của Find để viết cho gọn và không test kỹ các trưởng hợp.
Câu lệnh rfind2 = Selection.Find(What:=dulieu, After:=Cells(rfind1, c)).Row tìm theo điều kiện dễ nhất,sẽ tìm dạng tương tự. Bảo tìm 10 thì 210, 310, 101, 1000, ... đều đúng. Với một số yêu cầu tìm kiếm khác thì đúng, nhưng với yêu cầu tìm dữ liệu trùng thì hoàn toàn sai !

Câu lệnh trên cần sửa lại:
rfind2 = Selection.Find(What:=dulieu, After:=Cells(rfind1, c), LookAt:=xlWhole, SearchOrder:=xlByColumns).Row

Trong câu này có thêm 2 Option hạn chế cách tìm của Find là:

SearchOrder:=xlByColumns (Search By Columns: tìm trong cột)

LookAt:=xlWhole (Match entire cell constents: tìm đúng nội dung trong ô) do thiếu đoạn này mà sai




 

File đính kèm

  • XoaTrung.zip
    8.2 KB · Đọc: 199
Bạn phải đăng nhập hoặc đăng ký để trả lời bài viết tại đây.
Web KT

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

T
Nhờ giúp tính tổng ô đã Merge
Trả lời
2
Đọc
47
thuytrangbp28
T
LuuAnh980
  • Question
Code lấy dữ liệu từ 3 file con.
2 3 4
Trả lời
64
Đọc
961
VetMini
V
S
Sao excel lại biến dữ liệu thành dữ liệu nhiều các con số?
Trả lời
11
Đọc
130
ongke0711
ongke0711
A
  • Question
cách dùng lockxls bảo vệ file
Trả lời
18
Đọc
3K
chintn
chintn
emlat3
Đặt màu xen kẽ các dòng theo ký tự
Trả lời
6
Đọc
154
emlat3
emlat3
Xem thêm…

Facebook

Giaiphapexcel.com

Group

DIỄN ĐÀN GIẢI PHÁP EXCEL Group 1
DIỄN ĐÀN GIẢI PHÁP EXCEL Group 2

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng

Back
Top Bottom