Loại bỏ các ô trùng nhau trong 1 sheet excel (1 người xem)

[suamaytinhhcm]

mình cần xóa các ô dữ liệu trùng nhau trong 1 file excel gồm nhiều hàng và nhiều cột.
nhiều ô có cùng giá trị sẽ chỉ để lại 1 ô đầu tiên thôi.
nếu được thì sắp xếp các ô còn lại theo từng cột càng tốt.
file mẫu. thank mọi người giúp đỡ.

 

[vu_tuan_manh_linh]

Công thức tại F2=IF(COUNTIF($A$2:A$6;B2)=0;B2;""). Fill hết vùng chọn là Ok!!!

 

[suamaytinhhcm]

như thế không được bạn ơi.
mình muốn xóa thôi.
với dữ liệu của mình tới vài triệu ô lận. nếu dùng công thức này thì khó lắm
thank bro đã giúp. hy vọng góp ý thêm

 

[nginh]

như thế không được bạn ơi.
mình muốn xóa thôi.
với dữ liệu của mình tới vài triệu ô lận. nếu dùng công thức này thì khó lắm
thank bro đã giúp. hy vọng góp ý thêm

Dùng sub đơn giản sau

Sub clear()
Set R = Range("data")
For Each cell In R
x = cell.Value
If WorksheetFunction.CountIf(R, cell) <> 0 Then
R.Cells.Find(cell, , , , , xlPrevious).ClearContents
cell.Value = x
End If
Next
End Sub

Đặt name vùng dữ liệu là "data"

 

[nghiaphuc]

Dùng sub đơn giản sau

Sub clear()
Set R = Range("data")
For Each cell In R
x = cell.Value
If WorksheetFunction.CountIf(R, cell) <> 0 Then
R.Cells.Find(cell, , , , , xlPrevious).ClearContents
cell.Value = x
End If
Next
End Sub

Đặt name vùng dữ liệu là "data"

Hình như code này xóa chưa hết các ô trùng.
Mình thử tham gia một code khác xem sao:
[GPECODE=vb]Sub ClearAndSort_()
Dim R As Range, Cll As Range, Cll1 As Range
Set R = Range("Data")
For Each Cll In R
If IsEmpty(Cll) Then GoTo TiepTheo
Set Cll1 = R.Find(Cll, , , xlWhole)
Do While Cll1.Address <> Cll.Address
Cll1.ClearContents
Set Cll1 = R.FindNext(Cll1)
Loop
TiepTheo:
Next
For Each Cll In R.Resize(1)
Cll.Resize(R.Rows.Count).Sort Cll, xlDescending
Next
End Sub[/GPECODE]

 

[suamaytinhhcm]

Hình như code này xóa chưa hết các ô trùng.
Mình thử tham gia một code khác xem sao:
[GPECODE=vb]Sub ClearAndSort_()
Dim R As Range, Cll As Range, Cll1 As Range
Set R = Range("Data")
For Each Cll In R
If IsEmpty(Cll) Then GoTo TiepTheo
Set Cll1 = R.Find(Cll, , , xlWhole)
Do While Cll1.Address <> Cll.Address
Cll1.ClearContents
Set Cll1 = R.FindNext(Cll1)
Loop
TiepTheo:
Next
For Each Cll In R.Resize(1)
Cll.Resize(R.Rows.Count).Sort Cll, xlDescending
Next
End Sub[/GPECODE]

thanks 2 bro góp ý.
mình đã áp dụng 2 cách trên.
nhưng làm trong trường 3 triệu dữ liệu thì không khả thi. chạy treo luôn.
ai có cách nào mong chỉ giáo thêm

 

[dhn46]

Bạn thử với sub này xem sao

Sub RDuplicates()
Dim Arr(), iR As Long, jC As Long, Obj As Object
Set Obj = CreateObject("Scripting.Dictionary")
Arr = Range("Data").Value
For jC = 1 To UBound(Arr, 2)
    For iR = 1 To UBound(Arr, 1)
        If Not Obj.Exists(Arr(iR, jC)) Then
            Obj.Add Arr(iR, jC), ""
        Else
            Arr(iR, jC) = ""
        End If
    Next
Next
[E2].Resize(UBound(Arr, 1), UBound(Arr, 2)) = Arr
Set Obj = Nothing
End Sub

 

[suamaytinhhcm]

cảm ơn anh dhn46 nhiều.
chạy hơi lag nhưng ok với trường 4 cột data