Delete các dòng thừa (1 người xem)

[bbc]

Hi cả nhà,
E đang có bài tập như sau nhờ cả nhà giúp đỡ ah. Trong cột E, em có các số serial Number, tuy nhiên một số số serial No bị trùng, e muốn xóa các dòng trùng nhưng không phải xóa cả dòng mà chỉ xóa các dòng trong khoảng từ cột E đến cột G (sau đó là shift cells up).
Nếu các dòng bị trùng thì sẽ xóa dòng phía dưới, ví dụ dữ liệu ở dòng số 7 và dòng 26 giống nhau thì sẽ xóa dòng 26.
Cả nhà giúp e nhé
E cảm ơn rất nhiều

Ah e bổ sung thêm là e muốn làm một macro nhé (có combo button ấy a)

 

[concogia]

Ah e bổ sung thêm là e muốn làm một macro nhé (có combo button ấy a)

Muốn macro thì có macro nhưng cái "thằng" combo button mình không biết làm

Private Sub CommandButton1_Click()
    Dim Vung As Range, I As Long
    Set Vung = Range([e6], [e1000].End(xlUp))
        For I = Vung.Rows.Count To 1 Step -1
            If Application.WorksheetFunction.CountIf(Vung, Vung(I)) > 1 Then Vung(I).Resize(, 3).Delete Shift:=xlUp
        Next
End Sub

Làm ở sheet 1 nhé, sheet data giữ lại để kiểm tra

 

[bbc]

Cảm ơn bác concogia nhiều nha, cho e hỏi chút, nếu cột D có dữ liệu, e muốn xóa dữ liệu ở cột D đến cột G thì code sẽ là thế nào ah
E cảm ơn

 

[concogia]

Cảm ơn bác concogia nhiều nha, cho e hỏi chút, nếu cột D có dữ liệu, e muốn xóa dữ liệu ở cột D đến cột G thì code sẽ là thế nào ah
E cảm ơn

Như thế này

Private Sub CommandButton1_Click()
    Dim Vung As Range, I As Long
    Set Vung = Range([e6], [e1000].End(xlUp))
        For I = Vung.Rows.Count To 1 Step -1
            If Application.WorksheetFunction.CountIf(Vung, Vung(I)) > 1 Then Vung(I).Offset(0, -1).Resize(, 4).Delete Shift:=xlUp
        Next
End Sub

Thân

 

[ThuNghi]

Như thế này

Private Sub CommandButton1_Click()
    Dim Vung As Range, I As Long
    Set Vung = Range([e6], [e1000].End(xlUp))
        For I = Vung.Rows.Count To 1 Step -1
            If Application.WorksheetFunction.CountIf(Vung, Vung(I)) > 1 Then Vung(I).Offset(0, -1).Resize(, 4).Delete Shift:=xlUp
        Next
End Sub

Thân

Bác cogia lúc này viết code mau và ngắn gọn quá.
Nếu thành 60.000 rows. Bác cogia sẽ xử lý theo hướng nào.
Em xin đề xuất dùng PP Array thử với 9 cột và 60.000 dòng.
1/ Sort và dùng array

Sub DeleteSort()
Dim T, i As Long, s As Long, k As Long
Dim Vung As Range
Dim Arr(), ArrKQ()
T = Timer()
Sheets("Test").Select
Set Vung = Range([E5], [M65000].End(xlUp))
Vung.Sort Key1:=Vung.Cells(1, 1), Order1:=xlAscending, Header:=xlYes
Arr = Vung.Value
ReDim ArrKQ(1 To UBound(Arr) - 1, 1 To 9)
s = 1
For i = 2 To UBound(Arr) - 1
  For k = 1 To 9
      ArrKQ(s, k) = Arr(i, k)
    Next k
  If Arr(i, 1) <> Arr(i + 1, 1) Then s = s + 1
  Next i
With [E6]
  .Resize(i, 9).ClearContents
  .Resize(s, 9).Value = ArrKQ
End With

MsgBox Timer() - T
End Sub

2/ Cách 2 dùng Dictionary, hình như là nhanh hớn cách 1

Sub DeleteArr()
Dim T, i As Long, s As Long, k As Long
Dim Arr(), ArrKQ()
Dim Dic As Object
T = Timer()
Set Dic = CreateObject("Scripting.Dictionary")
Sheets("Test").Select
Arr = Range([E6], [M65000].End(xlUp)).Value
ReDim ArrKQ(1 To UBound(Arr), 1 To 9)
s = 0
For i = 1 To UBound(Arr)
  If Not Dic.exists(Arr(i, 1)) Then
    s = s + 1
    For k = 1 To 9
      ArrKQ(s, k) = Arr(i, k)
    Next k
    Dic.Add Arr(i, 1), i
  End If
Next i
With [E6]
  .Resize(i, 9).ClearContents
  .Resize(s, 9).Value = ArrKQ
End With
MsgBox Timer() - T
End Sub

Dạo này em cứ thấy bỏ dòng trùng hay lọc duy nhất là em dùng Dic, rất hiệu quả.
Bác xem file, run Refresh tăng số dòng lên và run thử.
Buồn chọt Bác chơi. No body invite me to drink some ....

 

[nmhung49]

Dạo này em cứ thấy bỏ dòng trùng hay lọc duy nhất là em dùng Dic, rất hiệu quả.
Bác xem file, run Refresh tăng số dòng lên và run thử.

Cho em hỏi mình dùng Dic trong trường hợp này, và trong trường hợp nào nữa anh ThuNghi có thể giải thích rõ hơn giúp em được không

 

[ThuNghi]

Dạo này em cứ thấy bỏ dòng trùng hay lọc duy nhất là em dùng Dic, rất hiệu quả.
Bác xem file, run Refresh tăng số dòng lên và run thử.

Cho em hỏi mình dùng Dic trong trường hợp này, và trong trường hợp nào nữa anh ThuNghi có thể giải thích rõ hơn giúp em được không

Ứng dụng thì khá nhiều đó, em xem link sau của anh Duyệt.
http://www.giaiphapexcel.com/forum/...uy-nhất-từ-một-danh-sách&highlight=dictionary
Hay những loạt bài của NDU về dictionary, giờ tìm chưa ra. Hình như là file tên là "TransferArray...".
Dùng Dic này trích duy nhất hay Vlookup cũng khá nhanh nhất là data > 10.000 rows. Nhưng với điều kiện kết hợp thêm Array thì mới nhanh.

 

[ndu96081631]

Bác cogia lúc này viết code mau và ngắn gọn quá.
Nếu thành 60.000 rows. Bác cogia sẽ xử lý theo hướng nào.
Em xin đề xuất dùng PP Array thử với 9 cột và 60.000 dòng.

Dù dùng cách gì đi nữa tôi nghĩ chắc cũng không nhanh hơn CÁI CÓ SẲN:
- Với Office 2007: Dùng chức năng Remove Duplicate
- Với Office 2003: Viết 1 sub dựa trên cơ sở AdvancedFilter:

Sub RemoveDuplicate()
  Dim FilterRng As Range, TG As Double
  On Error Resume Next
  With Application.InputBox("Chon vung du lieu" & vbLf & _
       "Bao gom ca tieu de", Type:=8)
    If .Cells Is Nothing Then Exit Sub
    TG = Timer
    Application.ScreenUpdating = False
    .AdvancedFilter 1, , , True
    Set FilterRng = .SpecialCells(12)
    .Parent.ShowAllData
    FilterRng.EntireRow.Hidden = True
    .SpecialCells(12).Delete 2
    .Parent.Cells.EntireRow.Hidden = False
  End With
  Application.ScreenUpdating = True
  MsgBox Timer - TG
End Sub

Có thể tạo 1 User Form giống như Advanced Filer Form của Excel để dùng lâu dài
Đoạn code SpecialCells(12).Delete 2 là xóa theo kiểu Shift cells up ---> Nếu muốn xóa nguyên dòng thì chỉ cần sửa lại chổ này là xong
Code này hơi bị THẦN TỐC à nha!