Nhờ anh chị viết code giúp em, lấy giá trị không trùng ra sheet khác

[sonchuot90]

Em có dữ liệu cột A sheet1, và cột L sheet2, bây giờ em sẽ tìm các giá trị cột A so với cột L, nếu các giá trị cột A không trùng với cột L thì sẽ trả kết quả không trùng sang cột D sheet2, do dữ liệu em nhiều, lên em muốn dùng VBA, vậy mong anh chị giúp đỡ em. Em cám ơn ạ

 

[BuiQuangThuan]

Dạ. Em thử thì em thấy mã chuyển về kho không đúng lắm. Mã chuyển về kho dựa vào điều kiện mã dài ( cột D).nhưng anh đang lấy theo mã ngắn (cột C) thì phải. Có vẻ không đúng lắm ạ

Ngồi lò dò xem thử xem có đúng không?
Bản thân chẳng biết thay đổi dữ liệu ra sao để test xem nó đúng hay sai.
Cứ thấy giống anh ở trên là tưởng đúng.
Trái ngang thật

Sub ABC()
    Dim sArr(), Res(), Dic As Object, i&, iR&, Arr(), K&, X, j&, Y, Vung As Range
    Y = Array("2", "3", "4", "6", "7")
    X = Array("2", "1", "3", "3", "4")
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("OK")
        iR = .Range("L" & Rows.Count).End(3).Row
        sArr = .Range("L2:L" & iR).Value
        Set Vung = .Range("J2:K" & iR)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Item(sArr(i, 1)) = i
            End If
        Next
    End With
    With Sheets("data")
        iR = .Range("A" & Rows.Count).End(3).Row
        Arr = .Range("A2:D" & iR).Value
        ReDim Res(1 To UBound(Arr), 1 To 7)
        For i = 1 To UBound(Arr)
            If Dic.exists(Arr(i, 1)) = False Then
                K = K + 1
                Res(K, 1) = K
                For j = 0 To 4
                    Res(K, CLng(Y(j))) = Arr(i, CLng(X(j)))
                Next
                If Not Vung.Find((Res(K, 3)), , xlValues, , xlByRows) Is Nothing Then
                    Res(K, 5) = Sheets("OK").Cells(Vung.Find((Res(K, 3)), , xlValues, , xlByRows).Row, "L").Value
                End If
            End If
        Next
        If K Then
            Sheets("OK").Range("B13:H100000").ClearContents
            Sheets("OK").Range("B13").Resize(K, 7).Value = Res
        End If
    End With
    Set Dic = Nothing
End Sub

 

[Hoàng Tuấn 868]

Ngồi lò dò xem thử xem có đúng không?
Bản thân chẳng biết thay đổi dữ liệu ra sao để test xem nó đúng hay sai.
Cứ thấy giống anh ở trên là tưởng đúng.
Trái ngang thật

Sub ABC()
    Dim sArr(), Res(), Dic As Object, i&, iR&, Arr(), K&, X, j&, Y, Vung As Range
    Y = Array("2", "3", "4", "6", "7")
    X = Array("2", "1", "3", "3", "4")
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("OK")
        iR = .Range("L" & Rows.Count).End(3).Row
        sArr = .Range("L2:L" & iR).Value
        Set Vung = .Range("J2:K" & iR)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Item(sArr(i, 1)) = i
            End If
        Next
    End With
    With Sheets("data")
        iR = .Range("A" & Rows.Count).End(3).Row
        Arr = .Range("A2:D" & iR).Value
        ReDim Res(1 To UBound(Arr), 1 To 7)
        For i = 1 To UBound(Arr)
            If Dic.exists(Arr(i, 1)) = False Then
                K = K + 1
                Res(K, 1) = K
                For j = 0 To 4
                    Res(K, CLng(Y(j))) = Arr(i, CLng(X(j)))
                Next
                If Not Vung.Find((Res(K, 3)), , xlValues, , xlByRows) Is Nothing Then
                    Res(K, 5) = Sheets("OK").Cells(Vung.Find((Res(K, 3)), , xlValues, , xlByRows).Row, "L").Value
                End If
            End If
        Next
        If K Then
            Sheets("OK").Range("B13:H100000").ClearContents
            Sheets("OK").Range("B13").Resize(K, 7).Value = Res
        End If
    End With
    Set Dic = Nothing
End Sub

Lại đổi món sang Find à.

 

[BuiQuangThuan]

Lại đổi món sang Find à.

Cho nó đỡ trùng máu anh ạ.

 

[sonchuot90]

Ngồi lò dò xem thử xem có đúng không?
Bản thân chẳng biết thay đổi dữ liệu ra sao để test xem nó đúng hay sai.
Cứ thấy giống anh ở trên là tưởng đúng.
Trái ngang thật

Sub ABC()
    Dim sArr(), Res(), Dic As Object, i&, iR&, Arr(), K&, X, j&, Y, Vung As Range
    Y = Array("2", "3", "4", "6", "7")
    X = Array("2", "1", "3", "3", "4")
    Set Dic = CreateObject("scripting.dictionary")
    With Sheets("OK")
        iR = .Range("L" & Rows.Count).End(3).Row
        sArr = .Range("L2:L" & iR).Value
        Set Vung = .Range("J2:K" & iR)
        For i = 1 To UBound(sArr)
            If Dic.exists(sArr(i, 1)) = False Then
                Dic.Item(sArr(i, 1)) = i
            End If
        Next
    End With
    With Sheets("data")
        iR = .Range("A" & Rows.Count).End(3).Row
        Arr = .Range("A2:D" & iR).Value
        ReDim Res(1 To UBound(Arr), 1 To 7)
        For i = 1 To UBound(Arr)
            If Dic.exists(Arr(i, 1)) = False Then
                K = K + 1
                Res(K, 1) = K
                For j = 0 To 4
                    Res(K, CLng(Y(j))) = Arr(i, CLng(X(j)))
                Next
                If Not Vung.Find((Res(K, 3)), , xlValues, , xlByRows) Is Nothing Then
                    Res(K, 5) = Sheets("OK").Cells(Vung.Find((Res(K, 3)), , xlValues, , xlByRows).Row, "L").Value
                End If
            End If
        Next
        If K Then
            Sheets("OK").Range("B13:H100000").ClearContents
            Sheets("OK").Range("B13").Resize(K, 7).Value = Res
        End If
    End With
    Set Dic = Nothing
End Sub

dạ, bây giờ ra kết quả chuẩn rồi anh ạ, em cám ơn anh ạ