Sửa dùm em đoạn code của anh SA_DQ

[rosy84]

Em không hiểu sao code cua anh SA_DQ khi chạy với dữ liệu này lại sai kết quả.


Muc đích là tìm các mã giống nhau và sắp theo đúng thứ tự, mã nào có trong cột này mà không có trong cột kia thì bỏ trống cột bên kia,

MA MA2
vx100 vx100
vx101
vx102
vx202
vx301 vx301

 

[ChanhTQ@]

Bạn hãy cho biết, kết quả sai chổ nào mới được chú, phải thế không?

Sau khi cho macro chạy, mình thấy bên vùng I có 07 dòng trống tương ứng bên vùng II là các Ma2 trùng với Ma2 của record ngay phía trên nó!

Tóm lại, bạn muốn kết quả ra sao, thì nên đưa minh họa lên trong 1 sheets nữa đi.

Mong tin bạn!

 

[rosy84]

anh chạy thấy nó không bị sai hả, nó mất hết những dòng cuối rồi mà, đây là kết qủa mà em lam.

 

[ChanhTQ@]

Một số Ma trùng nhau thì ứng xử sao đây?

Mình dùng đoạn mã sau & phát hiện thấy hơn 40 ma tại cột 'B' trùng nhau
như vậy sẽ làm sao ở cột 'N' trở đi?. Để trống hàng đó từ cột 'N' hay sao?

Có thể do vấn đề này mà mất vài chục records của bạn chăng.
Chờ tin bạn.

Option Explicit
Sub TimTrung()
 Dim bRw As Long, Jj As Long
 Dim aRow As Integer
  
 Columns("B:L").Select
 Selection.Sort Key1:=Range("B2"), Order1:=xlAscending, Header:=xlGuess, OrderCustom:=1
 bRw = [b65500].End(xlUp).Row
 Application.ScreenUpdating = False
 For Jj = 1 To bRw
  With Cells(Jj, "B")
    If .Value = .Offset(1).Value Then
      aRow = aRow + 1
      .Cells().Interior.ColorIndex = 34 + (aRow Mod 6)
      .Offset(1).Interior.ColorIndex = 35 + (aRow Mod 6)
      .Offset(, -1) = aRow
    End If
  End With
 Next Jj
End Sub

 

[SA_DQ]

Tại bạn đưa file lên không tiêu biểu hết các điều kiện thôi!

Xem thêm trong file đính kèm;

Macro sẽ làm các việc như sau:
* Nếu Ma không có bên Ma2, sẽ tô màu đỏ ô đó;
* Nếu Ma đã có trùng trong cột 'B' sẽ tô màu lam & để trống dòng này từ sau cột 'L'
* Nếu Ma2 không có bên Ma, sẽ để trống dòng dữ liệu thuộc vùng có cột 'B'

Option Explicit
Sub TimTrung()
 Dim bRw As Long, Jj As Long
 Dim Rng As Range, sRng As Range, cRng As Range
 
 Application.ScreenUpdating = False
   For Jj = 1 To 2
      Choose(Jj, Columns("B:L"), Columns("N:R")).Select
      Selection.Sort Key1:=Choose(Jj, [B2], [N2]), Order1:=xlAscending, _
         Header:=xlGuess, OrderCustom:=1
   Next Jj
   bRw = [b65500].End(xlUp).Row
   For Jj = 2 To bRw
      With Cells(Jj, "B")
         If .Value <> .Offset(, 12).Value And .Offset(-1).Value = .Value _
            And .Value <> "" Then
            Set Rng = Range([N1], [N65500].End(xlUp))
            Set sRng = Rng.Find(.Value, , xlFormulas, xlWhole)
            If sRng Is Nothing Then
               .Interior.ColorIndex = 3
            Else
               If sRng.Row < .Row Then
                  Range(.Offset(, 12), Cells(65500, "N").End(xlUp)).Resize(, 12).Cut
                  .Offset(1, 12).Select:                ActiveSheet.Paste
                  .Interior.ColorIndex = 35
               Else
                  Range(.Cells(), Cells(65500, "B").End(xlUp)).Resize(, 12).Cut
                  Cells(sRng.Row, "B").Select:            ActiveSheet.Paste
               End If
            End If
         End If
      End With
 Next Jj
End Sub

 

[rosy84]

Cảm ơn anh nha, đúng là em chưa đưa ra hết các tình huống có thể gặp phải trong quá trình làm.
Thanks các anh nhìu.
Có gì em không làm được em post bài lên diễn đàn các anh giúp dùng em nhe!!