Xóa toàn bộ các dòng trùng dữ liệu tại 1 cột

[hadoan-pap]

Em chào mọi người ạ.

Em muốn xóa toàn bộ các dòng bị trùng dữ liệu tại cột C ( không giữ lại dòng nào ) , em tìm code nhưng thấy hầu như là chỉ xóa 1 dòng và giữ lại 1 dòng... Dạ làm thế nào để xóa toàn bộ đi ạ.?

Vùng dữ liệu của em "A:Z" ạ. Nếu trùng dữ liệu tại cột C thì nó sẽ xóa toàn bộ các dòng trùng đó mà KHÔNG giữ lại dòng nào.

Em xin cảm ơn ạ!

 

[befaint]

tìm code

Gửi cái đã tìm được đó lên đây.

Vùng dữ liệu của em "A:Z" ạ. Nếu trùng dữ liệu tại cột C thì nó sẽ xóa toàn bộ các dòng trùng đó mà KHÔNG giữ lại dòng nào.

Mình cho ví dụ minh họa cụ tỉ.

 

[hadoan-pap]

Dạ đây đại ca!

Workbooks(file).Sheets("Payment Upload Template").Range("A:I").RemoveDuplicates Columns:=3, Header:=xlYes

E muốn xóa toàn bộ các dòng trùng dữ liệu tại cột thứ 3 ( cột C ) và không giữ lại dòng nào ạ. Nhưng code trên thì nó đang giữ lại 1 dòng anh ạ

 

[Nhattanktnn]

Dạ đây đại ca!

Workbooks(file).Sheets("Payment Upload Template").Range("A:I").RemoveDuplicates Columns:=3, Header:=xlYes

E muốn xóa toàn bộ các dòng trùng dữ liệu tại cột thứ 3 ( cột C ) và không giữ lại dòng nào ạ. Nhưng code trên thì nó đang giữ lại 1 dòng anh ạ

Nghĩ ra vậy chứ chưa làm:
Có mấy kiểu, dùng countif của worksheetfunction, nếu >1 là trùng. Dùng dictionary, hoặc dùng vòng lặp duyệt qua mảng chứa dữ liệu đó. Phát hiện được cái nào thì union vào một range cuối code xóa một lần. Xóa từng dòng trong for bị chậm

 

[hadoan-pap]

Gửi cái đã tìm được đó lên đây.


Mình cho ví dụ minh họa cụ tỉ.

Dạ em mới làm theo cách này, dài dòng hơn nhưng cũng được rồi ạ.

Dim rng1 As Range
Dim lRow As Long
Dim i1 As Long

lRow = Workbooks(file).Sheets("Payment Upload Template").Range("C" & Rows.Count).End(xlUp).Row
Set rng1 = Workbooks(file).Sheets("Payment Upload Template").Range("C2", Workbooks(file).Sheets("Payment Upload Template").Cells(Rows.Count, "C").End(xlUp))

For Each cell In rng1
If WorksheetFunction.CountIf(rng1, cell.Value) > 1 Then
cell.Interior.ColorIndex = 6
End If
Next cell

For i1 = lRow To 2 Step -1
If Workbooks(file).Sheets("Payment Upload Template").Cells(i1, 3).Interior.ColorIndex = 6 Then
Workbooks(file).Sheets("Payment Upload Template").Rows(i1).Delete
End If
Next

 

[Nhattanktnn]

Dạ em mới làm theo cách này, dài dòng hơn nhưng cũng được rồi ạ.

Dim rng1 As Range
Dim lRow As Long
Dim i1 As Long

lRow = Workbooks(file).Sheets("Payment Upload Template").Range("C" & Rows.Count).End(xlUp).Row
Set rng1 = Workbooks(file).Sheets("Payment Upload Template").Range("C2", Workbooks(file).Sheets("Payment Upload Template").Cells(Rows.Count, "C").End(xlUp))

For Each cell In rng1
If WorksheetFunction.CountIf(rng1, cell.Value) > 1 Then
cell.Interior.ColorIndex = 6
End If
Next cell

For i1 = lRow To 2 Step -1
If Workbooks(file).Sheets("Payment Upload Template").Cells(i1, 3).Interior.ColorIndex = 6 Then
Workbooks(file).Sheets("Payment Upload Template").Rows(i1).Delete
End If
Next

Rồi sao không xóa trong vòng for trên đi mà lại tô màu rồi vòng for khác mới xóa?
Nói thêm, tô màu vậy nếu dữ liệu có sẵn màu như vậy thì khi xóa sẽ xóa nhầm đấy nhé

 

[hadoan-pap]

Rồi sao không xóa trong vòng for trên đi mà lại tô màu rồi vòng for khác mới xóa?
Nói thêm, tô màu vậy nếu dữ liệu có sẵn màu như vậy thì khi xóa sẽ xóa nhầm đấy nhé

Cảm ơn anh, file này thì nguyên sơ nó k có màu mè gì ạ.

Còn nếu xóa ở trong for thì em thử chưa tìm dc cách xóa tất dòng trùng khi loop, nó chỉ xóa dc 1 dòng thôi ạ.

 

[Nhattanktnn]

Cảm ơn anh, file này thì nguyên sơ nó k có màu mè gì ạ.

Còn nếu xóa ở trong for thì em thử chưa tìm dc cách xóa tất dòng trùng khi loop, nó chỉ xóa dc 1 dòng thôi ạ.

Khi đã viết code là phải suy nghĩ đến trường hợp có thể xảy ra trừ trường hợp dùng 1 lần rồi bỏ.
Nên khai báo cell thành Clls hoặc đại loại vậy.
cell.Interior.ColorIndex = 6 được thì cũng có thể cell.entirerow.delete được thôi
Chuyện nhanh chậm tính sau đi, bạn cứ viết được code chạy ngon lành thì dần dần bạn sẽ phải nghĩ tới chuyện cải thiện tốc độ thôi

 

[befaint]

cell.Interior.ColorIndex = 6 được thì cũng có thể cell.entirerow.delete được

Xóa rồi thì lượt cuối không xóa được vì đếm = 1.

 

[Nhattanktnn]

Xóa rồi thì lượt cuối không xóa được vì đếm = 1.

à em nhầm to rồi. Lúc đầu đinh ninh union xóa một lần nên sau quên mất! chết thật

 

[SA_DQ]

. . . . Em muốn xóa toàn bộ các dòng bị trùng dữ liệu tại cột C ( không giữ lại dòng nào ) , em tìm code nhưng thấy hầu như là chỉ xóa 1 dòng và giữ lại 1 dòng... Dạ làm thế nào để xóa toàn bộ đi ạ.?
Vùng dữ liệu của em "A:Z" ạ. Nếu trùng dữ liệu tại cột C thì nó sẽ xóa toàn bộ các dòng trùng đó mà KHÔNG giữ lại dòng nào. . . . . .

(1) DL (dữ liệu) của bạn bao nhiêu dòng vậy? (Nếu ít thì bất chấp tốc độ & ngược lại)
(2) Người có nhã í muốn giúp bạn phải tự tạo ra file giả lập hay sao, hàng tháng chỉ có ~ 5 ngày sung rụng thôi & chúc bạn không chán trong cuộc đợi chờ này!
. . . . .

 

[SA_DQ]

Option Explicit
Sub XoaDongTrung()
 Dim Tmr As Double, Rws As Long, J As Long, W As Long, Col As Integer, Cot As Integer
 Dim Rng As Range, sRng As Range, Sh As Worksheet
  
 Set Sh = ThisWorkbook.Worksheets("GPE")
 Set Rng = Sh.UsedRange:                    Tmr = Timer()
 Rws = Rng.Rows.Count:                      Col = Rng.Columns.Count
 ReDim Arr(1 To Rws, 1 To Col)
 For J = 6 To Rws
    If Sh.Cells(J, "C").Value <> Space(0) Then
        Set Rng = Union(Sh.Range(Sh.[c4], Sh.Cells(J - 1, "C")), _
            Sh.Range(Sh.Cells(J + 1, "C"), Sh.Cells(Rws, "C")))
        Set sRng = Rng.Find(Sh.Cells(J, "C").Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            W = W + 1
            For Cot = 1 To Col
                Arr(W, Cot) = Sh.Cells(J, Cot).Value
            Next Cot
        End If
    End If
 Next J
 MsgBox Timer() - Tmr
 MsgBox W, , Rws
End Sub

 

[hadoan-pap]

Option Explicit
Sub XoaDongTrung()
 Dim Tmr As Double, Rws As Long, J As Long, W As Long, Col As Integer, Cot As Integer
 Dim Rng As Range, sRng As Range, Sh As Worksheet
 
 Set Sh = ThisWorkbook.Worksheets("GPE")
 Set Rng = Sh.UsedRange:                    Tmr = Timer()
 Rws = Rng.Rows.Count:                      Col = Rng.Columns.Count
 ReDim Arr(1 To Rws, 1 To Col)
 For J = 6 To Rws
    If Sh.Cells(J, "C").Value <> Space(0) Then
        Set Rng = Union(Sh.Range(Sh.[c4], Sh.Cells(J - 1, "C")), _
            Sh.Range(Sh.Cells(J + 1, "C"), Sh.Cells(Rws, "C")))
        Set sRng = Rng.Find(Sh.Cells(J, "C").Value, , xlFormulas, xlWhole)
        If sRng Is Nothing Then
            W = W + 1
            For Cot = 1 To Col
                Arr(W, Cot) = Sh.Cells(J, Cot).Value
            Next Cot
        End If
    End If
 Next J
 MsgBox Timer() - Tmr
 MsgBox W, , Rws
End Sub

Dạ em cảm ơn ạ!