So sánh và thay thế khi dữ liệu lệch.

[ntwl1080]

Em dùng vba so sánh 2 sheet, trong trường hợp cột MA_BN và cột NGAY_VAO khớp nhau thì so sánh tiếp cột NGAY_RA, nếu NGAY_RA của 7980 không khớp với XML thì lấy cột NGAY_RA của XML điền vô 7980.
trong trường hợp MA_BN lặp lại thì ko điền được (3 dòng màu đen) các thầy giúp em với. em cảm ơn!

 

[Ba Tê]

Em dùng vba so sánh 2 sheet, trong trường hợp cột MA_BN và cột NGAY_VAO khớp nhau thì so sánh tiếp cột NGAY_RA, nếu NGAY_RA của 7980 không khớp với XML thì lấy cột NGAY_RA của XML điền vô 7980.
trong trường hợp MA_BN lặp lại thì ko điền được (3 dòng màu đen) các thầy giúp em với. em cảm ơn!

Sheet "7980" bạn format cột P kiểu Text cho giống cột O.
Chạy thử code này:

Public Sub s_Gpe()
Dim Dic As Object, sArr(), dArr(), I As Long, R As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
sArr = Sheets("XML").Range("B2", Sheets("XML").Range("B2").End(xlDown)).Resize(, 18).Value
R = UBound(sArr)
For I = 1 To R
    Tem = sArr(I, 1) & "#" & sArr(I, 17)
    Dic.Item(Tem) = sArr(I, 18)
Next I
With Sheets("7980")
    sArr = .Range("B2", .Range("B2").End(xlDown)).Resize(, 14).Value
    R = UBound(sArr)
    dArr = .Range("P2").Resize(R).Value
    For I = 1 To R
        Tem = sArr(I, 1) & "#" & sArr(I, 14)
        If Dic.Exists(Tem) Then dArr(I, 1) = Dic.Item(Tem)
    Next I
    .Range("P2").Resize(R) = dArr
End With
Set Dic = Nothing
End Sub

 

[CHAOQUAY]

Em dùng vba so sánh 2 sheet, trong trường hợp cột MA_BN và cột NGAY_VAO khớp nhau thì so sánh tiếp cột NGAY_RA, nếu NGAY_RA của 7980 không khớp với XML thì lấy cột NGAY_RA của XML điền vô 7980.
trong trường hợp MA_BN lặp lại thì ko điền được (3 dòng màu đen) các thầy giúp em với. em cảm ơn!

Nguyên nhân là mấy dòng này của bạn

For Each Rng2 In ShtXML.Range("B2:B" & dongcuoiXML)
    If Not .exists(Rng2.Value) Then .Add Rng2.Value, Rng2.row
Next Rng2

Bạn chạy thử code dưới đây xem sao

Sub XMLvs7980()
Dim SArr As Variant
Dim DArr As Variant
Dim i As Long, j As Long
Dim Text_ As String
Dim Dic_ As Object
Set Dic_ = CreateObject("Scripting.Dictionary")
SArr = Sheet2.Range("a1").CurrentRegion
DArr = Sheet3.Range("a1").CurrentRegion
For i = 2 To UBound(SArr)
    Text_ = SArr(i, 2) & Left(SArr(i, 18), 8)
    If Not Dic_.exists(Text_) Then Dic_.Add Text_, SArr(i, 19)
Next i
With Sheet3
    For i = 2 To UBound(DArr)
        Text_ = DArr(i, 2) & Left(DArr(i, 15), 8)
        If Dic_.exists(Text_) Then
            If DArr(i, 16) <> Dic_(Text_) Then
                .Range("p" & i).Interior.ColorIndex = 6
                .Range("p" & i).NumberFormat = "@"
                .Range("p" & i) = Dic_(Text_)
            End If
        End If
    Next i
End With
Set Dic_ = Nothing
End Sub

 

[ntwl1080]

Dạ cảm ơn Thầy, 2 code đều chạy ok rồi ạ.

 

[phulien1902]

Dạ cảm ơn Thầy, 2 code đều chạy ok rồi ạ.

Sao bài này không có File mà 2 thầy làm giỏi thế nhỉ?

 

[CHAOQUAY]

Sao bài này không có File mà 2 thầy làm giỏi thế nhỉ?

Thầy bà gì đâu nghe ghê quá bạn.
Thớt này ban đầu có file kèm theo, giờ không hiểu sao biến đâu mất tiêu

 

[phulien1902]

Thầy bà gì đâu nghe ghê quá bạn.
Thớt này ban đầu có file kèm theo, giờ không hiểu sao biến đâu mất tiêu

Vậy thì Code của bác Ba tê và của bạn còn ý nghĩa gì nữa?