Code VBA tìm mã kiện gỗ còn tồn kho

[moihocvba]

Em chào anh chị, em làm bên nhập xuất kho kiện gỗ, em cần danh sách các kiện còn tồn trong kho khi so sanh giữa bảng nhập và bảng xuất, biết rằng các kiện có thể trùng tên nhau, ví dụ bảng nhập Mặt hàng A có 2 kiện 120A, khi xuất đi 1 kiện 120A thì tồn kho sẽ còn tồn 1 kiện 120A (không phân biệt thứ tự số trước sau)

Kết quả mà em cần nó hiển thị ở phần màu vàng như hình em minh họa, anh chị có thể giúp em code vba với ạ, em xin cám ơn nhiều ạ!
Em cần giúp code vì bảng nhập và xuất có hàng ngàn dòng nên phải dùng code mới nhanh ạ, anh chị làm demo trên dữ liệu em gửi, em về em tập chỉnh lại như file của em ạ.

 

[HUONGHCKT]

Em chào anh chị, em làm bên nhập xuất kho kiện gỗ, em cần danh sách các kiện còn tồn trong kho khi so sanh giữa bảng nhập và bảng xuất, biết rằng các kiện có thể trùng tên nhau, ví dụ bảng nhập Mặt hàng A có 2 kiện 120A, khi xuất đi 1 kiện 120A thì tồn kho sẽ còn tồn 1 kiện 120A (không phân biệt thứ tự số trước sau)

Kết quả mà em cần nó hiển thị ở phần màu vàng như hình em minh họa, anh chị có thể giúp em code vba với ạ, em xin cám ơn nhiều ạ!
Em cần giúp code vì bảng nhập và xuất có hàng ngàn dòng nên phải dùng code mới nhanh ạ, anh chị làm demo trên dữ liệu em gửi, em về em tập chỉnh lại như file của em ạ.

View attachment 306439

Dòng A11 có phải là 123A không? bạn xem lại.
Nếu Các ô tô vàng là các mã kiện duy nhất thì tham khảo code củ chuối sau:

Option Explicit

Sub TonKho()
Dim i&, j&, Lr&, t&, k&
Dim ArrN(), ArrX(), KQ(), S
Dim Dic As Object, Key
Set Dic = CreateObject("Scripting.Dictionary")

With Sheet1
Lr = .Range("A100000").End(xlUp).Row
ArrN = .Range("A4:D" & Lr).Value
ReDim KQ(1 To UBound(ArrN) * 3, 1 To 2)
Lr = .Range("F100000").End(xlUp).Row
ArrX = .Range("F4:I" & Lr).Value
End With

For i = 1 To UBound(ArrN)
    For j = 2 To UBound(ArrN, 2)
        If ArrN(i, j) <> Empty Then
            Key = ArrN(i, 1) & "#" & ArrN(i, j)
            If Not Dic.Exists(Key) Then
                t = t + 1: Dic.Add (Key), t
                Dic(Key) = 1
            Else
                Dic(Key) = Dic(Key) + 1
            End If
        End If
    Next j
Next i

For i = 1 To UBound(ArrX)
    For j = 2 To UBound(ArrX, 2)
        If ArrX(i, j) <> Empty Then
            Key = ArrX(i, 1) & "#" & ArrX(i, j)
            If Dic.Exists(Key) Then
                S = Split(Dic(Key), "|")
                If UBound(S) = 0 Then
                    Dic(Key) = Dic(Key) & "|" & 1
                Else
                    Dic(Key) = Dic(Key) & "|" & S(1) + 1
                End If
            End If
        End If
    Next j
Next i
For Each Key In Dic.Keys
    S = Split(Dic(Key), "|")
        If UBound(S) > 0 Then
            If S(0) - S(1) > 0 Then
                k = k + 1
                KQ(k, 1) = Split(Key, "#")(0)
                KQ(k, 2) = Split(Key, "#")(1)
            End If
        Else
            k = k + 1
                KQ(k, 1) = Split(Key, "#")(0)
                KQ(k, 2) = Split(Key, "#")(1)
        End If
Next Key
Sheet2.Range("C2").Resize(k, 2) = KQ
End Sub

Xem file

 

[HieuCD]

Em chào anh chị, em làm bên nhập xuất kho kiện gỗ, em cần danh sách các kiện còn tồn trong kho khi so sanh giữa bảng nhập và bảng xuất, biết rằng các kiện có thể trùng tên nhau, ví dụ bảng nhập Mặt hàng A có 2 kiện 120A, khi xuất đi 1 kiện 120A thì tồn kho sẽ còn tồn 1 kiện 120A (không phân biệt thứ tự số trước sau)

Kết quả mà em cần nó hiển thị ở phần màu vàng như hình em minh họa, anh chị có thể giúp em code vba với ạ, em xin cám ơn nhiều ạ!
Em cần giúp code vì bảng nhập và xuất có hàng ngàn dòng nên phải dùng code mới nhanh ạ, anh chị làm demo trên dữ liệu em gửi, em về em tập chỉnh lại như file của em ạ.

View attachment 306439

Mượn file của bạn @HUONGHCKT, chạy code

Sub xyz()
  Dim aNhap(), aXuat(), res(), S, Dic As Object, key$
  Dim i&, j&, k&
 
  Set Dic = CreateObject("Scripting.Dictionary")
  With Sheet1
    aNhap = .Range("A4:D" & .Range("A100000").End(xlUp).Row).Value
    ReDim res(1 To UBound(aNhap) * (UBound(aNhap, 2) - 1), 1 To 2)
    aXuat = .Range("F4:I" & .Range("F100000").End(xlUp).Row).Value
  End With

  For i = 1 To UBound(aXuat)
    If aXuat(i, 1) <> Empty Then
      For j = 2 To UBound(aXuat, 2)
        If aXuat(i, j) <> Empty Then
          key = aXuat(i, 1) & "|" & aXuat(i, j)
          Dic(key) = Dic(key) + 1
        End If
      Next j
    End If
  Next i

  For i = 1 To UBound(aNhap)
    If aNhap(i, 1) <> Empty Then
      For j = 2 To UBound(aNhap, 2)
        If aNhap(i, j) <> Empty Then
          key = aNhap(i, 1) & "|" & aNhap(i, j)
          If Dic.Exists(key) Then
            Dic(key) = Dic(key) - 1
            If Dic(key) = 0 Then Dic.Remove (key)
          Else
            k = k + 1
            res(k, 1) = aNhap(i, 1)
            res(k, 2) = aNhap(i, j)
          End If
        End If
      Next j
    End If
  Next i
  Sheet2.Range("C2").Resize(k, 2) = res
End Sub