Mọi người giúp mình xóa các dòng trùng nhau với

anhcua · 6/7/14

hiện mình đang muốn muốn xóa các dòng trùng nhau như sau:
1
2
2
3
Có cách nào để xóa dòng trùng nhau để có kết quả như này không mọi người?
Kết quả:
1
3
--=0

mong các bác chỉ giáo, em sài excel 2010

chuot0106 · 6/7/14

anhcua đã viết:
hiện mình đang muốn muốn xóa các dòng trùng nhau như sau:
1
2
2
3
Có cách nào để xóa dòng trùng nhau để có kết quả như này không mọi người?
Kết quả:
1
3
mong các bác chỉ giáo, em sài excel 2010

Cách thì chắc chắn là có nhưng bạn nên đưa File giả lập nên để các thành viên xem mặt mũi nó ra sao(nói rõ mong muốn trong đó) chứ! Nếu việc đơn giản này mà bạn cũng không làm được nữa thì thôi vậy!

chuot0106 · 6/7/14

anhcua đã viết:
hiện mình đang muốn muốn xóa các dòng trùng nhau như sau:
1
2
2
3
Có cách nào để xóa dòng trùng nhau để có kết quả như này không mọi người?
Kết quả:
1
3
mong các bác chỉ giáo, em sài excel 2010

Mở File nhấn nút "xoá" nhé! Sai ráng chịu vì làm mò! Hi

Quang_Hải · 6/7/14

anhcua đã viết:
hiện mình đang muốn muốn xóa các dòng trùng nhau như sau:
1
2
2
3
Có cách nào để xóa dòng trùng nhau để có kết quả như này không mọi người?
Kết quả:
1
3
mong các bác chỉ giáo, em sài excel 2010

Giả sử dữ liệu của bạn tại A2:A10, tại B2 nhập công thức này vào rồi kéo xuống
=COUNTIF($A$2:$A$10,A2)
Sau đó dùng AutoFiter để cho hiển thị những số nào khác số 1 và xóa 1 phát là xong hết

chuot0106 · 6/7/14

anhcua đã viết:
hiện mình đang muốn muốn xóa các dòng trùng nhau như sau:
1
2
2
3
Có cách nào để xóa dòng trùng nhau để có kết quả như này không mọi người?
Kết quả:
1
3
mong các bác chỉ giáo, em sài excel 2010

Dùng File này nhé, File trước tôi nhầm hàm!

chuot0106 · 6/7/14

File này vẫn chưa đúng do ko đọc kĩ đề bài.

chuot0106 · 6/7/14

anhcua đã viết:
hiện mình đang muốn muốn xóa các dòng trùng nhau như sau:
1
2
2
3
Có cách nào để xóa dòng trùng nhau để có kết quả như này không mọi người?
Kết quả:
1
3
mong các bác chỉ giáo, em sài excel 2010

Tôi làm theo cách củ chuối này, bạn Test thử xem đúng không nhé?

Mã:

Public Sub xoa_dong_trung()
Dim i As Long, j As Long, k As Long, arr(), rng As Range, rng1 As Range, Dic As Object, kq()


With Sheet1
Set rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
Set rng1 = .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row)


arr = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
ReDim kq(1 To UBound(arr), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        If Not Dic.exists(arr(i, 1)) Then
            j = j + 1
            Dic.Add arr(i, 1), 1
            kq(j, 1) = arr(i, 1)
        End If
    Next i
    .Range("IV2").Resize(j, 1) = kq


    For i = 1 To rng1.Rows.Count
        k = Application.WorksheetFunction.CountIf(rng, rng1(i, 1))
        If k > 1 Then rng1(i, 1).EntireRow.Delete
    Next i
        .Range("A2:A" & .Range("A65500").End(xlUp).Row).ClearContents
        .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).Copy .Range("A2")
        .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).ClearContents
End With
End Sub

P/S: Mong các thầy, các bạn các anh chị cùng Test và nếu có thể tối ưu giúp em hoặc có thể đưa ra phương án khác hay hơn!

thangteotdtt · 6/7/14

Mình làm chơi thôi. chắc cũng không áp dụng được. Hi hi

chuot0106 · 6/7/14

thangteotdtt đã viết:
Xem thử coi có được không nhé bạn.

Hic! Thế nó có khoảng 100 dòng trùng mà muốn xóa thi cũng phải đánh hết 100 số dòng hả bạn? Chưa kể không biết có tìm chính xác xem nó ở dòng nào nữa mà đánh.

thangteotdtt · 6/7/14

chuot0106 đã viết:
Hic! Thế nó có khoảng 100 dòng trùng mà muốn xóa thi cũng phải đánh hết 100 số dòng hả bạn? Chưa kể không biết có tìm chính xác xem nó ở dòng nào nữa mà đánh.

Hì, làm chơi thôi mà bạn, file của bạn cũng có đúng đâu. VD: Trong file

Quang_Hải · 6/7/14

chuot0106 đã viết:

Tôi làm theo cách củ chuối này, bạn Test thử xem đúng không nhé?

Mã:

Public Sub xoa_dong_trung()
Dim i As Long, j As Long, k As Long, arr(), rng As Range, rng1 As Range, Dic As Object, kq()


With Sheet1
Set rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
Set rng1 = .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row)


arr = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
ReDim kq(1 To UBound(arr), 1 To 1)
Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
        If Not Dic.exists(arr(i, 1)) Then
            j = j + 1
            Dic.Add arr(i, 1), 1
            kq(j, 1) = arr(i, 1)
        End If
    Next i
    .Range("IV2").Resize(j, 1) = kq


    For i = 1 To rng1.Rows.Count
        k = Application.WorksheetFunction.CountIf(rng, rng1(i, 1))
        If k > 1 Then rng1(i, 1).EntireRow.Delete
    Next i
        .Range("A2:A" & .Range("A65500").End(xlUp).Row).ClearContents
        .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).Copy .Range("A2")
        .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).ClearContents
End With
End Sub

P/S: Mong các thầy, các bạn các anh chị cùng Test và nếu có thể tối ưu giúp em hoặc có thể đưa ra phương án khác hay hơn!

Đây là 1 cách dùng Dic để loại dữ liệu trùng

PHP:

ub xoa_du_lieu_trung()
Dim dl(), i As Long, tam(), k As Long
dl = Range([A2], [A65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
      If Not .exists(dl(i, 1)) Then
         .Add dl(i, 1), ""
      Else
         k = k + 1
         ReDim Preserve tam(1 To k)
         tam(k) = dl(i, 1)
      End If
   Next
   For i = 1 To k
      If .exists(tam(i)) Then
         .Remove (tam(i))
      End If
   Next
   [B2].Resize(.Count) = Application.Transpose(.Keys)
End With
End Sub

ndu96081631 · 6/7/14

chuot0106 đã viết:
=

P/S: Mong các thầy, các bạn các anh chị cùng Test và nếu có thể tối ưu giúp em hoặc có thể đưa ra phương án khác hay hơn!

Thừa nhiều quá! Vầy là được rồi:

Mã:

Public Sub xoa_dong_trung()
  Dim i As Long, j As Long, arr(), rng As Range, Dic As Object, kq()
  With Sheet1
    Set rng = .Range(.[A2], .[A65500].End(xlUp))
  End With
  arr = rng.Value
  ReDim kq(1 To UBound(arr), 1 To 1)
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arr)
    If Not Dic.exists(arr(i, 1)) Then
      j = j + 1
      Dic.Add arr(i, 1), 1
      kq(j, 1) = arr(i, 1)
    End If
  Next i
  Sheet1.Range("A2").Resize(i - 1).Value = kq
End Sub

chuot0106 · 6/7/14

quanghai1969 đã viết:

Đây là 1 cách dùng Dic để loại dữ liệu trùng

PHP:

ub xoa_du_lieu_trung()
Dim dl(), i As Long, tam(), k As Long
dl = Range([A2], [A65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(dl)
      If Not .exists(dl(i, 1)) Then
         .Add dl(i, 1), ""
      Else
         k = k + 1
         ReDim Preserve tam(1 To k)
         tam(k) = dl(i, 1)
      End If
   Next
   For i = 1 To k
      If .exists(tam(i)) Then
         .Remove (tam(i))
      End If
   Next
   [B2].Resize(.Count) = Application.Transpose(.Keys)
End With
End Sub

Mong anh cùng các thầy, các anh chị và các bạn xem hộ em đoạn code em viết với, không biết em có sai ở đâu không mà lúc đúng lúc sai.
Ý tưởng của em là:
+ Dùng Dic lọc ra các giá trị không trùng để kết quả ra 1 vùng khác.
+ Dùng countif đếm lần lượt các kết quả đã lọc ở trong vùng dữ liệu ban đầu gán kết quả đếm vào biến k.
+ Kiểm tra nếu k>1 tức trùng thì xóa dòng chứa dữ liệu trùng đó.
+ Copy kết quả lọc sau khi đã xóa dòng trùng, dán đè nên vùng ban đầu.

Quang_Hải · 6/7/14

ndu96081631 đã viết:

Thừa nhiều quá! Vầy là được rồi:

Mã:

Public Sub xoa_dong_trung()
  Dim i As Long, j As Long, arr(), rng As Range, Dic As Object, kq()
  With Sheet1
    Set rng = .Range(.[A2], .[A65500].End(xlUp))
  End With
  arr = rng.Value
  ReDim kq(1 To UBound(arr), 1 To 1)
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arr)
    If Not Dic.exists(arr(i, 1)) Then
      j = j + 1
      Dic.Add arr(i, 1), 1
      kq(j, 1) = arr(i, 1)
    End If
  Next i
  Sheet1.Range("A2").Resize(i - 1).Value = kq
End Sub

Hình như code của anh là lọc duy nhất thì phải?

chuot0106 · 6/7/14

ndu96081631 đã viết:

Thừa nhiều quá! Vầy là được rồi:

Mã:

Public Sub xoa_dong_trung()
  Dim i As Long, j As Long, arr(), rng As Range, Dic As Object, kq()
  With Sheet1
    Set rng = .Range(.[A2], .[A65500].End(xlUp))
  End With
  arr = rng.Value
  ReDim kq(1 To UBound(arr), 1 To 1)
  Set Dic = CreateObject("Scripting.Dictionary")
  For i = 1 To UBound(arr)
    If Not Dic.exists(arr(i, 1)) Then
      j = j + 1
      Dic.Add arr(i, 1), 1
      kq(j, 1) = arr(i, 1)
    End If
  Next i
  Sheet1.Range("A2").Resize(i - 1).Value = kq
End Sub

Có lẽ thầy chưa đọc kỹ yêu cầu của tác giả rồi! Ý tác giả không phải là lọc dữ liệu duy nhất mà là muốn xóa toàn bộ các dòng có dữ liệu trùng cơ!

ndu96081631 · 6/7/14

quanghai1969 đã viết:
Hình như code của anh là lọc duy nhất thì phải?

Ah! Đúng là chưa xem kỹ (chỉ chạy code của chuột và... đoán). Ẹc... Ẹc...
Lỡ rồi, chơi code này cho nó hoành tráng:

Mã:

Sub Test()
  Dim arrSrc, Arr(), Item
  Dim tmp As String
  Dim n As Long, lMark As Long
  arrSrc = Sheet1.Range("A2:A10000").Value
  Sheet1.Range("A2:A10000").ClearContents
  ReDim Arr(1 To UBound(arrSrc, 1), 1 To 1)
  With CreateObject("Scripting.Dictionary")
    For Each Item In arrSrc
      If Len(CStr(Item)) Then
        tmp = CStr(Item)
        If Not .Exists(tmp) Then
          n = n + 1
          .Add tmp, n
          Arr(n, 1) = tmp
        ElseIf .Item(tmp) > 0 Then
          lMark = .Item(tmp)
          .Item(tmp) = 0
          If lMark < n Then
            .Item(Arr(n, 1)) = lMark
            Arr(lMark, 1) = Arr(n, 1)
          End If
          n = n - 1
        End If
      End If
    Next
    If .Count Then
      If n Then
        Sheet1.Range("A2").Resize(n).Value = Arr
        MsgBox n & " phan tu duoc tim thay"
      Else
        MsgBox "Tat ca du lieu deu trung"
      End If
    Else
      MsgBox "Không tìm thay du lieu nao"
    End If
  End With
End Sub

Một vòng lập duy nhất và không chơi WorksheetFunction đâu nhé
Phù.... Xong!
Nói thêm: Bài này nếu đã dùng đến COUNTIF thì quá dễ để xử lý đi, thậm chí là không cần đến Dic. Và nếu đã dùng Dic thì phải tận dụng hết "sức mạnh" của nó
Ẹc... Ẹc...

chuot0106 · 6/7/14

ndu96081631 đã viết:
Ah! Đúng là chưa xem kỹ (chỉ chạy code của chuột và... đoán). Ẹc... Ẹc...
Lỡ rồi, chơi code này cho nó hoành tráng:
................
Một vòng lập duy nhất và không chơi WorksheetFunction đâu nhé
Phù.... Xong!
Nói thêm: Bài này nếu đã dùng đến COUNTIF thì quá dễ để xử lý đi, thậm chí là không cần đến Dic. Và nếu đã dùng Dic thì phải tận dụng hết "sức mạnh" của nó
Ẹc... Ẹc...

Thầy ơi code của thầy quá Ok rồi, thầy làm ơn giải thích giúp em tai sao code của em lại cho kết quả không đúng! Em viết rất rõ ý tưởng ở đây ạ! #13

Quang_Hải · 6/7/14

ndu96081631 đã viết:
Ah! Đúng là chưa xem kỹ (chỉ chạy code của chuột và... đoán). Ẹc... Ẹc...
Lỡ rồi, chơi code này cho nó hoành tráng:
...................
Một vòng lập duy nhất và không chơi WorksheetFunction đâu nhé
Phù.... Xong!
Nói thêm: Bài này nếu đã dùng đến COUNTIF thì quá dễ để xử lý đi, thậm chí là không cần đến Dic. Và nếu đã dùng Dic thì phải tận dụng hết "sức mạnh" của nó
Ẹc... Ẹc...

Anh chơi code này là Knock Out gần hết rồi, còn sót lại vài mạng thôi... Sao nỡ lòng đem Long Đầu Trảm ra chém thường dân vậy anh?

ndu96081631 · 6/7/14

chuot0106 đã viết:
Thầy ơi code của thầy quá Ok rồi, thầy làm ơn giải thích giúp em tai sao code của em lại cho kết quả không đúng! Em viết rất rõ ý tưởng ở đây ạ! #13

Tại vì... sai code thôi (dù ý tưởng là đúng)
Sửa lại của bạn nè:

Mã:

Public Sub xoa_dong_trung()
  Dim i As Long, j As Long, k As Long, arr(), rng As Range, rng1 As Range, Dic As Object, kq()
  With Sheet1
    Set rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row)
    arr = rng.Value
    ReDim kq(1 To UBound(arr), 1 To 1)
    Set Dic = CreateObject("Scripting.Dictionary")
    For i = 1 To UBound(arr)
      If Not Dic.exists(arr(i, 1)) Then
        j = j + 1
        Dic.Add arr(i, 1), 1
        kq(j, 1) = arr(i, 1)
      End If
    Next i
    .Range("IV2").Resize(j, 1) = kq
    [COLOR=#ff0000]Set rng1 = .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row)[/COLOR]
    [COLOR=#0000cd]For i = rng1.Rows.Count To 1 Step -1[/COLOR]
      k = Application.WorksheetFunction.CountIf(rng, rng1(i, 1))
      If k > 1 Then rng1(i, 1).EntireRow.Delete
    Next i
    .Range("A2:A" & .Range("A65500").End(xlUp).Row).ClearContents
    .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).Copy .Range("A2")
    .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).ClearContents
  End With
End Sub

Dòng màu đỏ: Bạn để phía trên là không đúng ---> Khi ấy cột IV có tí dữ liệu nào đâu mà Set rng1 ---> Vậy nên ta phải đặt lệnh Set rng1 tại vị trí khi mà IV có dữ liệu
Dòng màu xanh: Phàm cứ xóa dòng thì bạn hãy nhớ cho rằng phải xóa từ dưới lên
----------------------
Chỉ là sửa code của bạn cho nó chạy đúng thôi chứ như tôi đã nói ở trên:
- Đã dùng COUNTIF thì khỏi Dic và ngược lại
- Nếu dùng Dic, để đơn giản hóa vấn đề, bạn có thể dùng 2 vòng lập. Khi nạp Dic chỉ cần đánh dấu vào Item nếu như phát hiện có trùng. Đến vòng lập thứ 2 là lọc ra được hết thôi

chuot0106 · 6/7/14

ndu96081631 đã viết:
Tại vì... sai code thôi (dù ý tưởng là đúng)
Sửa lại của bạn nè:

Mã:

Public Sub xoa_dong_trung() Dim i As Long, j As Long, k As Long, arr(), rng As Range, rng1 As Range, Dic As Object, kq() With Sheet1 Set rng = .Range("A2:A" & .Range("A65500").End(xlUp).Row) arr = rng.Value ReDim kq(1 To UBound(arr), 1 To 1) Set Dic = CreateObject("Scripting.Dictionary") For i = 1 To UBound(arr) If Not Dic.exists(arr(i, 1)) Then j = j + 1 Dic.Add arr(i, 1), 1 kq(j, 1) = arr(i, 1) End If Next i .Range("IV2").Resize(j, 1) = kq [COLOR=#ff0000]Set rng1 = .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row)[/COLOR] [COLOR=#0000cd]For i = rng1.Rows.Count To 1 Step -1[/COLOR] k = Application.WorksheetFunction.CountIf(rng, rng1(i, 1)) If k > 1 Then rng1(i, 1).EntireRow.Delete Next i .Range("A2:A" & .Range("A65500").End(xlUp).Row).ClearContents .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).Copy .Range("A2") .Range("IV2:IV" & .Range("IV65500").End(xlUp).Row).ClearContents End With End Sub

Dòng màu đỏ: Bạn để phía trên là không đúng ---> Khi ấy cột IV có tí dữ liệu nào đâu mà Set rng1 ---> Vậy nên ta phải đặt lệnh Set rng1 tại vị trí khi mà IV có dữ liệu
Dòng màu xanh: Phàm cứ xóa dòng thì bạn hãy nhớ cho rằng phải xóa từ dưới lên
----------------------
Chỉ là sửa code của bạn cho nó chạy đúng thôi chứ như tôi đã nói ở trên:
- Đã dùng COUNTIF thì khỏi Dic và ngược lại
- Nếu dùng Dic, để đơn giản hóa vấn đề, bạn có thể dùng 2 vòng lập. Khi nạp Dic chỉ cần đánh dấu vào Item nếu như phát hiện có trùng. Đến vòng lập thứ 2 là lọc ra được hết thôi

Thầy ơi em test thử code thầy đã sửa hộ em nhưng kết quả vần không đúng ạ!
Thầy xem File!

Mọi người giúp mình xóa các dòng trùng nhau với

Thành viên mới

Thành viên gắn bó

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

Thành viên gắn bó

Thành viên gắn bó

File đính kèm

Thành viên hoạt động

File đính kèm

Thành viên gắn bó

Thành viên hoạt động

File đính kèm

Thành viên gạo cội

Huyền thoại GPE

Thành viên gắn bó

Thành viên gạo cội

Thành viên gắn bó

Huyền thoại GPE

Thành viên gắn bó

Thành viên gạo cội

Huyền thoại GPE

Thành viên gắn bó

File đính kèm

Đếm ngược thời gian