Cập nhật giữ liệu qua các sheet theo diều kiện

lhthai

Thành viên thường trực

18/6/15

Cập nhật những mã hàng của sheet DMPP nào không trùng vào 3 sheet NVY, AVP, IV theo điều kiện
điều kiện mình ghi trong file đính kèm.
Hiện tại code Update 2 trong file của mình chỉ cập nhật được sheet 2 nay muốn bổ sung thêm điều kiện

Mã:

Private Sub CommandButton2_Click()
Dim Dic As Object, sArr(), dArr(), I As Long, k As Long, Tem As String
Set Dic = CreateObject("Scripting.Dictionary")
With Sheet2
        sArr = .Range(.[B5], .[B5].End(xlDown)).Resize(, 3).Value
        For I = 1 To UBound(sArr, 1)
            Tem = sArr(I, 1) & sArr(I, 2) & sArr(I, 3)
            If Not Dic.exists(Tem) Then
                Dic.Add Tem, Empty
            End If
        Next I
    End With
 With Sheet3
        sArr = .Range(.[B5], .[B5].End(xlDown)).Resize(, 3).Value
        For I = 1 To UBound(sArr, 1)
            Tem = sArr(I, 1) & sArr(I, 2) & sArr(I, 3)
            If Not Dic.exists(Tem) Then
                Dic.Add Tem, Empty
            End If
        Next I
    End With
 With Sheet4
        sArr = .Range(.[B5], .[B5].End(xlDown)).Resize(, 3).Value
        For I = 1 To UBound(sArr, 1)
            Tem = sArr(I, 1) & sArr(I, 2) & sArr(I, 3)
            If Not Dic.exists(Tem) Then
                Dic.Add Tem, Empty
            End If
        Next I
    End With
With Sheet5
    sArr = .Range(.[B9], .[B9].End(xlDown)).Resize(, 3).Value
    ReDim dArr(1 To UBound(sArr, 1), 1 To 3)
    For I = 1 To UBound(sArr, 1)
        Tem = sArr(I, 1) & sArr(I, 2) & sArr(I, 3)
        If Not Dic.exists(Tem) Then
            k = k + 1
            Dic.Add Tem, Empty
            dArr(k, 1) = sArr(I, 1)
            dArr(k, 2) = sArr(I, 2)
            dArr(k, 3) = sArr(I, 3)
        End If
    Next I
    End With
    With Sheet2
        If k Then
    .[B65536].End(xlUp)(2).Resize(k, 3) = dArr
    Else
      Exit Sub
     End If
    End With
End Sub