So sánh dữ liệu theo cột 2 sheet khác nhau!!!

[trieucuong.ise17]

Chào các thầy và các bạn!

Em đang học về VBA thôi nên chưa có nhiều kiến thức và đang gặp bài toán nan giải.
Mục đích là dò tìm theo mã sản xuất ở cột D sheet "MPS" và so sánh với mã sản xuất ở cột D sheet "Theo dõi". Nếu mã sản xuất chưa có ở cột D sheet "Theo dõi" thì copy các hàng chứa mã sản xuất không bị trùng và chèn lên đầu các đơn hàng (hàng thứ 3). Nếu mã sản xuất trùng thì sẽ bỏ qua.
Em có đính kèm file Excel mẫu bên dưới.
Cảm ơn các thầy và các bạn giúp đỡ!

 

[Hai Lúa Miền Tây]

Chào các thầy và các bạn!

Em đang học về VBA thôi nên chưa có nhiều kiến thức và đang gặp bài toán nan giải.
Mục đích là dò tìm theo mã sản xuất ở cột D sheet "MPS" và so sánh với mã sản xuất ở cột D sheet "Theo dõi". Nếu mã sản xuất chưa có ở cột D sheet "Theo dõi" thì copy các hàng chứa mã sản xuất không bị trùng và chèn lên đầu các đơn hàng (hàng thứ 3). Nếu mã sản xuất trùng thì sẽ bỏ qua.
Em có đính kèm file Excel mẫu bên dưới.
Cảm ơn các thầy và các bạn giúp đỡ!

Có trường hợp nào trong bảng theo dõi có mà trong bảng kia không có không bạn?

 

[VetMini]

Ây da, giải thuật này hay quá bác ạ. Đôi khi muốn tìm google cũng không nghĩ ra được từ khóa là gì mà kiếm luôn . Cảm ơn 2 bác nhiều!

Ây cái khỉ mốc. Code bài #14 có điểm không đúng:
1. Nếu A không chứa phần tử duy nhất thì giải thích ở cuối bài là sai:
- Nếu A có nhiều phần tử giống nhau thì vẫn rút gọn được. Nhưng chỉ dò được 1 lần, vì phần tử để dò ấy đã bị mất rồi.
2. Nếu B không chứa phần tử duy nhất thì vẫn rút gọn. Nhưng vẫn phải chạy suốt vòng lặp.
Mặt khác, nếu B chứa phần tử duy nhất thì vòng lặp phải exit ngay khi làm xong các nhiệm vụ của match.

 

[Ba Tê]

Tại sao phải insert em nghĩ chỉ cần dán 2 mảng vào là được mà.Dán mảng mới trước rồi đến mảng cũ.

Ý!!!!!
Vậy mà tôi không nghĩ ra.

Public Sub LuXuBu()
Const Cols As Long = 15
Dim Dic As Object, sArr(), dArr(), tArr()
Dim I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
    tArr = Sheets("MPS").Range("A1", Sheets("MPS").Range("D100000").End(xlUp)).Resize(, Cols).Value
    R1 = UBound(tArr)
    If R1 < 3 Then Exit Sub
    '------------------------------------'
With Sheets("TheoDoi")
    If .Range("D100000").End(xlUp).Row > 10 Then
        sArr = .Range("A11", .Range("D100000").End(xlUp)).Resize(, Cols).Value
        R2 = UBound(sArr)
        For I = 1 To R2
            Txt = sArr(I, 4) 'Ma san xuat sheet TheoDoi'
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = ""
        Next I
    End If
    '--------------------------------------'
    ReDim dArr(1 To R1 + R2, 1 To Cols)
    For I = 3 To R1
        Txt = tArr(I, 4)
        If Not Dic.Exists(Txt) Then
            K = K + 1   'Ma san xuat sheet MPS khong co trong sheet TheoDoi'
            For J = 1 To Cols
                dArr(K, J) = tArr(I, J)
            Next J
        End If
    Next I
    '----------------------------------------'
    If K Then
        .Range("A11").Resize(K, Cols) = dArr
        If R2 Then .Range("A" & 11 + K).Resize(R2, Cols) = sArr
        .Range("A" & 11 + R2).Resize(K, Cols).Borders.LineStyle = 1
    End If
End With
End Sub

 

[Hai Lúa Miền Tây]

Ây cái khỉ mốc. Code bài #14 có điểm không đúng:
1. Nếu A không chứa phần tử duy nhất thì giải thích ở cuối bài là sai:
- Nếu A có nhiều phần tử giống nhau thì vẫn rút gọn được. Nhưng chỉ dò được 1 lần, vì phần tử để dò ấy đã bị mất rồi.
2. Nếu B không chứa phần tử duy nhất thì vẫn rút gọn. Nhưng vẫn phải chạy suốt vòng lặp.
Mặt khác, nếu B chứa phần tử duy nhất thì vòng lặp phải exit ngay khi làm xong các nhiệm vụ của match.

Chỗ bài 1 em thấy còn hơi vướng mắc là chủ đề tài chưa nói rõ là trùng mã so với bảng TheoDoi hay là lấy dữ liệu duy nhất của bảng MPS sau khi loại bỏ những dòng dữ liệu đã có trong bảng TheoDoi.

 

[Hai Lúa Miền Tây]

Ý!!!!!
Vậy mà tôi không nghĩ ra.

Public Sub LuXuBu()
Const Cols As Long = 15
Dim Dic As Object, sArr(), dArr(), tArr()
Dim I As Long, J As Long, K As Long, R1 As Long, R2 As Long, Txt As String
Set Dic = CreateObject("Scripting.Dictionary")
    tArr = Sheets("MPS").Range("A1", Sheets("MPS").Range("D100000").End(xlUp)).Resize(, Cols).Value
    R1 = UBound(tArr)
    If R1 < 3 Then Exit Sub
    '------------------------------------'
With Sheets("TheoDoi")
    If .Range("D100000").End(xlUp).Row > 10 Then
        sArr = .Range("A11", .Range("D100000").End(xlUp)).Resize(, Cols).Value
        R2 = UBound(sArr)
        For I = 1 To R2
            Txt = sArr(I, 4) 'Ma san xuat sheet TheoDoi'
            If Not Dic.Exists(Txt) Then Dic.Item(Txt) = ""
        Next I
    End If
    '--------------------------------------'
    ReDim dArr(1 To R1 + R2, 1 To Cols)
    For I = 3 To R1
        Txt = tArr(I, 4)
        If Not Dic.Exists(Txt) Then
            K = K + 1   'Ma san xuat sheet MPS khong co trong sheet TheoDoi'
            For J = 1 To Cols
                dArr(K, J) = tArr(I, J)
            Next J
        End If
    Next I
    '----------------------------------------'
    If K Then
        .Range("A11").Resize(K, Cols) = dArr
        If R2 Then .Range("A" & 11 + K).Resize(R2, Cols) = sArr
        .Range("A" & 11 + K).Resize(K, Cols).Borders.LineStyle = 1
    End If
End With
End Sub

Góp vui thêm 1 cách bằng ADO:

Sub KiemTra_HLMT()
    Dim strSQL As String
    strSQL = "Select a.* From [MPS$A3:G] a Left Join [TheoDoi$] b On a.F4=b.F4 Where a.F4 Is Null Union All Select * From [MPS$A3:G]"
    With CreateObject("ADODB.Recordset")
        .Open strSQL, "Provider=Microsoft.ACE.OLEDB.12.0;Data Source=" & ThisWorkbook.FullName & ";Extended Properties=""Excel 12.0;HDR=No"""
        Sheet1.Range("A11").CopyFromRecordset .DataSource
    End With
End Sub

 

[trieucuong.ise17]

Dùng "dao mổ Trâu, chém loạn xà ngầu" thử xem:

Chân thành cảm ơn bác. Em đã có sửa lại được đoạn code theo ý và chạy tốt rồi ạ!