Cần giúp đỡ xóa các dòng chứa các ô cùng cột trùng nhau (Và giữ lại 1 dòng duy nhất) (1 người xem)

[hung2412]

Chào Quý vị và các bạn GPE!
Nhờ Quý vị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tự động xóa các dòng với điều kiện các ký tự các ô ở cột B trùng nhau (Không xóa hết và chỉ giữ lại một dòng duy nhất).
Ví dụ: Ô B7, B8, B9 có ký tự trùng nhau là "PX09/01-NN" => Xóa dòng 7, 8 (Giữ lại dòng 9).
Mong Quý vị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có file đính kèm.

 

[SA_DQ]

Bạn cho chạy macro XoaDong & kiểm tra số liệu mà macro tạo ra tại các cột bắt đầu từ [AA]
Nếu đúng rồi thì tới dòng lệnh:

   [AA6].Resize(Rws, 5).Value = dArr()

& xóa đi 1 chữ 'A' là được.

Chúc thành công.

 

[ndu96081631]

Chào Quý vị và các bạn GPE!
Nhờ Quý vị và các bạn giúp đỡ cho tôi vấn đề này với, cụ thể như sau:
Tự động xóa các dòng với điều kiện các ký tự các ô ở cột B trùng nhau (Không xóa hết và chỉ giữ lại một dòng duy nhất).
Ví dụ: Ô B7, B8, B9 có ký tự trùng nhau là "PX09/01-NN" => Xóa dòng 7, 8 (Giữ lại dòng 9).
Mong Quý vị và các bạn GPE chỉ giáo!
Trân trọng cảm ơn!
P/s: Có file đính kèm.

Tôi cứ nghĩ bạn đã biết cách dùng Advanced Filter để lọc duy nhất chứ

 

[hung2412]

Bạn cho chạy macro XoaDong & kiểm tra số liệu mà macro tạo ra tại các cột bắt đầu từ [AA]
Nếu đúng rồi thì tới dòng lệnh:

   [AA6].Resize(Rws, 5).Value = dArr()

& xóa đi 1 chữ 'A' là được.

Chúc thành công.

Sao mình chạy macro không thấy động tĩnh gì vậy ta, sao vậy nhỉ?

 

[hung2412]

Tôi cứ nghĩ bạn đã biết cách dùng Advanced Filter để lọc duy nhất chứ

Em không rành Advanced Filter, với lại em muốn chạy bằng VBA ạ.

 

[ChanhTQ@]

Em không rành Advanced Filter, với lại em muốn chạy bằng VBA ạ.

Thực ra vẫn có thể lọc mở rọng bằng VBA

Sao mình chạy macro không thấy động tĩnh gì vậy ta, sao vậy nhỉ?

Bạn cần kích hoạt trang 'S3', chạy macro hiện có; Khi đó kết quả hiện tại vùng [AA:AE]

Bạn thử lại xem sao.

 

[hung2412]

Thực ra vẫn có thể lọc mở rọng bằng VBA


Bạn cần kích hoạt trang 'S3', chạy macro hiện có; Khi đó kết quả hiện tại vùng [AA:AE]

Bạn thử lại xem sao.

Vâng, em đã text lại và nhận thấy đúng thế, nhưng mà có cách nào khác không ạ, vì vùng [AA:AE] lại phải định dạng lại cho đẹp (phông chữ, đậm nghiêng các kiểu,...). Vùng dữ liệu cũ xóa dòng như theo đề bài thì tốt quá, không phải định dạng lại.

 

[hung2412]

Em vừa mới học được một cách là: Sort cột B => tại ô F7 đặt công thức =IF(B7=B8;0;1) => Cột F chỉ có số 0 (trùng nhau) và số 1 (Không trùng nhau) => Chuyển cột F thành giá trị chết => Chạy VBA (Tự tạo) dọc theo cột F xóa dòng chứa ô có số 0 => Vẫn giữ nguyên được vùng cũ mà không phải định dạng chữ và số lại.

 

[SA_DQ]

Cũng có thể bạn qua các bước sau:

(*) Sort theo cột

(*) Tạo vòng lặp duyệt từ dòng gần cuối lên trên (dòng N-1 nếu N là dòng cuối)

(*) Nếu thấy dữ liệu cột của dòng đang duyệt này giống với dữ liệu cột của dòng cuối vừa duyệt thì xóa dòng cuối ấy đi.

 

[hung2412]

Cũng có thể bạn qua các bước sau:

(*) Sort theo cột

(*) Tạo vòng lặp duyệt từ dòng gần cuối lên trên (dòng N-1 nếu N là dòng cuối)

(*) Nếu thấy dữ liệu cột của dòng đang duyệt này giống với dữ liệu cột của dòng cuối vừa duyệt thì xóa dòng cuối ấy đi.

Vâng, em xài Code theo như Quý vị nói:

   Dim t as Long
   For t = [B65536].End(xlUp).Offset(-1, 0).Row To 7 Step -1
      If Cells(t, 2) = Cells(t + 1, 2) Then
         Cells(t + 1, 2).EntireRow.Delete
      End If
   Next

Đỡ phải loằng ngoằng nhiều.

 

[ndu96081631]

Em không rành Advanced Filter, với lại em muốn chạy bằng VBA ạ.

Viết code cho bạn bằng Advanced Filter đây:

Sub RemoveDuplicate(ByVal SourceRange As Range)
  Dim FilterRng As Range
  On Error Resume Next
  With SourceRange
    If .Rows.Count < 3 Then Exit Sub
    Application.ScreenUpdating = False
    .AdvancedFilter 1, , , True
    Set FilterRng = .SpecialCells(12)
    .Parent.ShowAllData
    FilterRng.EntireRow.Hidden = True
    '.SpecialCells(12).Delete 2
    .SpecialCells(12).EntireRow.Delete
    .Parent.Cells.EntireRow.Hidden = False
  End With
  Application.ScreenUpdating = True
End Sub
Sub Main()
  RemoveDuplicate Sheet1.Range("B6:B100")
End Sub

 

[ChanhTQ@]

Code của bạn còn 1 số vấn đề loằng ngoằng cần bàn, đó là:

Vâng, em xài Code theo như Quý vị nói:

   Dim t as Long
   For t = [B65536].End(xlUp).Offset(-1, 0).Row To 7 Step -1
      If Cells(t, 2) = Cells(t + 1, 2) Then
         Cells(t, 2).EntireRow.Delete
      End If
   Next

Đỡ phải loằng ngoằng nhiều.

(1) Về hướng duy chuyển: Bạn suy nghĩ xem, tại sao người hướng dẫn iêu cầu bạn duyệt các dòng từ dưới lên, mà không từ trên xuống?

(2) Về cách xóa: Có thể khai báo 1 tham biến kiểu vùng ô (như Dim Rng As Range,. ..
Sau đó, trong khi duyệt, các dòng cần xóa ta gán vô Rng;
Sau khi duyệt xong, ta xóa 1 lần có fải êm hơn không?

(3) Bạn thử viết macro cách mà ta có thể di chuyển (trong khi duyệt) từ trên xuống kết hợp với xóa 1 lần xem sao?!

(húc bạn thành công!

 

[hung2412]

(1) Về hướng duy chuyển: Bạn suy nghĩ xem, tại sao người hướng dẫn iêu cầu bạn duyệt các dòng từ dưới lên, mà không từ trên xuống?

(2) Về cách xóa: Có thể khai báo 1 tham biến kiểu vùng ô (như Dim Rng As Range,. ..
Sau đó, trong khi duyệt, các dòng cần xóa ta gán vô Rng;
Sau khi duyệt xong, ta xóa 1 lần có fải êm hơn không?

(3) Bạn thử viết macro cách mà ta có thể di chuyển (trong khi duyệt) từ trên xuống kết hợp với xóa 1 lần xem sao?!

(húc bạn thành công!

Dạ, em xin trả lời:
-Vấn đề 1: Em đã từng text ở bài khác, hướng di chuyển từ trên xuống dưới và nhận thấy rằng là có dòng không bị xóa. Chắc là do khi duyệt ô thuộc dòng cần xóa => Xóa dòng đó xong thì dòng dưới trồi lên (Dòng này cũng thuộc dạng cần xóa) và bị bỏ qua bởi macro duyệt nhảy luôn xuống dòng dưới nữa (Trình em hiểu chỉ có vậy thôi ạ).
- Vấn đề 2 và vấn đề 3: Nói thật là em thuộc dạng Amater (Đầu ngắn lắm ạ) => Thế em mới nhờ diễn đàn để học hỏi thêm (Tích lũy kiến thức dần).
=> Tổng kết lại là em mong Quý vị chỉ giáo thêm ạ.

 

[SA_DQ]

Dạ, em xin trả lời:
-Vấn đề 1: . . . . .
- Vấn đề 2 và vấn đề 3: Nói thật là em thuộc dạng Amater (Đầu ngắn lắm ạ) => Thế em mới nhờ diễn đàn để học hỏi thêm (Tích lũy kiến thức dần).
=> Tổng kết lại là em mong Quý vị chỉ giáo thêm ạ.

Bạn thử tìm hiểu & diễn dịch macro này

Option Explicit
Sub DuyetTuTrenXuongDeXoaDong()
 Dim lRw As Long, J As Long
 Dim dRg As Range
 
3 Sheets("S3").Select
 lRw = [B7].End(xlDown).Row
5 Set dRg = Rows(9 + lRw & ":" & 9 + lRw)
 For J = 8 To lRw
7    If Cells(J, "B").Value = Cells(J - 1, "B").Value Then
        Set dRg = Union(dRg, Cells(J, "B").EntireRow)
9    End If
 Next J
11 MsgBox dRg.Address, , J
 If Not dRg Is Nothing Then dRg.Delete
End Sub

Dòng lệnh nào chưa hiểu bạn có thể hỏi mọi người!

 

[hung2412]

Cũng có thể bạn qua các bước sau:

(*) Sort theo cột

(*) Tạo vòng lặp duyệt từ dòng gần cuối lên trên (dòng N-1 nếu N là dòng cuối)

(*) Nếu thấy dữ liệu cột của dòng đang duyệt này giống với dữ liệu cột của dòng cuối vừa duyệt thì xóa dòng cuối ấy đi.

Tôi sử dụng Code này (Không cần phải Sort):

Sub Xoa1()
Dim i As Long
Dim t As Long
  For i = [B65536].End(xlUp).Row To 7 Step -1
     For t = [B65536].End(xlUp).Row To i + 1 Step -1
           If Cells(i, 2) = Cells(t, 2) Then
              Cells(t, 2).EntireRow.Delete
           End If
     Next
  Next
End Sub

 

[Quang_Hải]

Tôi sử dụng Code này (Không cần phải Sort):

Sub Xoa1()
Dim i As Long
Dim t As Long
  For i = [B65536].End(xlUp).Row To 7 Step -1
     For t = [B65536].End(xlUp).Row To i + 1 Step -1
           If Cells(i, 2) = Cells(t, 2) Then
              Cells(t, 2).EntireRow.Delete
           End If
     Next
  Next
End Sub

Bạn có thể thử 2 sub bên dưới và cảm nhận tốc độ giữa xoá trực tiếp trên sheet và trên "trời" nếu là dữ liệu nhiều.

Sub RowDelete()
Dim Data(), i, j, k
Data = Range([A7], [E65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      If Not .exists(Data(i, 2)) Then
         k = k + 1
         .Add Data(i, 2), k
         Data(k, 1) = k
         For j = 2 To UBound(Data, 2)
            Data(k, j) = Data(i, j)
         Next
      End If
   Next
End With
[A7].Resize(i - 1, 5) = Data
[A7].Offset(k).Resize(i - k, 5).Clear
End Sub

Sub RemoveDuplicates()
Range([A7], [E65536].End(3)).RemoveDuplicates Array(2)
Range([A7], [A65536].End(3)) = [row(a:a)]
End Sub

 

[Kiều Mạnh]

Bạn có thể thử 2 sub bên dưới và cảm nhận tốc độ giữa xoá trực tiếp trên sheet và trên "trời" nếu là dữ liệu nhiều.

Sub RowDelete()
Dim Data(), i, j, k
Data = Range([A7], [E65536].End(3)).Value
With CreateObject("scripting.dictionary")
   For i = 1 To UBound(Data)
      If Not .exists(Data(i, 2)) Then
         k = k + 1
         .Add Data(i, 2), k
         Data(k, 1) = k
         For j = 2 To UBound(Data, 2)
            Data(k, j) = Data(i, j)
         Next
      End If
   Next
End With
[A7].Resize(i - 1, 5) = Data
[A7].Offset(k).Resize(i - k, 5).Clear
End Sub

Sub RemoveDuplicates()
Range([A7], [E65536].End(3)).RemoveDuplicates Array(2)
Range([A7], [A65536].End(3)) = [row(a:a)]
End Sub

code Dic em hiểu còn code dưới đang đau đầu Chữ Này "Array(2)"

 

[hung2412]

Sub RemoveDuplicates()
Range([A7], [E65536].End(3)).RemoveDuplicates Array(2)
Range([A7], [A65536].End(3)) = [row(a:a)]
End Sub

Cái Code này bị lỗi bạn ơi, không hiểu là tại làm sao?

 

[Quang_Hải]

Cái Code này bị lỗi bạn ơi, không hiểu là tại làm sao?

Vì là bạn đang xài Office 2003 đúng không. Nếu đúng là 2003 thì hãy quên hắn đi.

 

[hung2412]

Code cùi:
[GPECODE=vb]Sub Delete_Row()
Dim Dic As Object
Dim i As Long
Set Dic = CreateObject("Scripting.Dictionary")
For i = [B65536].End(xlUp).Row To 7 Step -1
If Cells(i, 2) <> "" Then
If Not Dic.exists(Cells(i, 2).Value) Then
Dic.Add Cells(i, 2).Value, Empty
Else
Cells(i, 2).EntireRow.Delete
End If
End If
Next
End Sub[/GPECODE]