Nhờ giúp đỡ code so sánh 2 bảng

Shaa · 21/11/23

Chào các anh/chị GPE,
Em đang có một vấn đề nhờ các anh/chị giúp đỡ ạ
Em có 2 danh sách chứa mã sản phẩm và mã nguyên vật liệu tương ứng
em cần tạo ra một danh sách mới với điều kiện như sau:
- Xét cùng một mã sản phẩm
+ Nếu có từ một nguyên vật liệu của danh sách 1 tồn tại trong danh sách 2 hoặc ngược lại thì nhặt cả 2 ra để so sánh số lượng
+ Các trường hợp không tồn tại mã nguyên vật liệu nào giống nhau thì bỏ qua
Các anh/chị giúp đỡ em với nhé
Em cảm ơn ạ

HUONGHCKT · 21/11/23

S.Ha đã viết:
Chào các anh/chị GPE,
Em đang có một vấn đề nhờ các anh/chị giúp đỡ ạ
Em có 2 danh sách chứa mã sản phẩm và mã nguyên vật liệu tương ứng
em cần tạo ra một danh sách mới với điều kiện như sau:
- Xét cùng một mã sản phẩm
+ Nếu có từ một nguyên vật liệu của danh sách 1 tồn tại trong danh sách 2 hoặc ngược lại thì nhặt cả 2 ra để so sánh số lượng
+ Các trường hợp không tồn tại mã nguyên vật liệu nào giống nhau thì bỏ qua
Các anh/chị giúp đỡ em với nhé
Em cảm ơn ạ

Trong khi chờ các giải pháp khác, hãy thử tham khảo code sau (làm theo ý hiểu của tôi)

Mã:

Option Explicit

Sub SHa()
Dim i&, j&, Lr&, Lr1&, t
Dim Arr(), Arr2(), KQ(), S, Tmp
Dim Dic As Object, key, Temp
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("DuLieu")
Lr = Sh.Cells(Rows.Count, 1).End(3).Row
Arr = Sh.Range("A4:C" & Lr).Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
    S = Split(Arr(i, 2), "/")
    For j = 0 To UBound(S)
        key = Arr(i, 1) & "#" & S(j)
            If Not Dic.Exists(key) Then
                Dic(key) = i
            End If
    Next j
Next i

Lr1 = Sh.Cells(Rows.Count, 5).End(3).Row
Arr2 = Sh.Range("E4:G" & Lr).Value
    For i = 1 To UBound(Arr2)
        Tmp = Split(Arr2(i, 2), "/")
        For j = 0 To UBound(Tmp)
            Temp = Arr2(i, 1) & "#" & Tmp(j)
            If Dic.Exists(Temp) Then
                t = t + 1
                KQ(t, 1) = Arr2(i, 1)
                KQ(t, 2) = Arr(Dic(Temp), 2)
                KQ(t, 3) = Arr(Dic(Temp), 3)
                KQ(t, 4) = Arr2(i, 2)
                KQ(t, 5) = Arr2(i, 3)
                KQ(t, 6) = KQ(t, 3) - KQ(t, 5)
                Exit For
            End If
        Next j
    Next i
Set Ws = Sheets("KetQua")
    If t Then
        Ws.Range("A12").Resize(1000, 6).ClearContents
        Ws.Range("A12").Resize(t, 6) = KQ
    End If
Set Dic = Nothing
End Sub

VetMini · 22/11/23

Nếu mã xuất hiện nhiều lần trong 1 bảng thì sao?
Giả sử chuyện ấy không xảy ra.

Mã:

' code lấy bảng 1 vào array a1, 3 cột
' code lấy bảng 2 vào array a2, 2 cột
' code lấy mã ở bảng 2 vào array a21, 1 cột để làm bảng dò
Dim b(1 To Rows.Count, 1 To 5) ' dữ liệu quá phức tạp, khó ước lượng đầu ra
For Each ma in A21 ' chuẩn bị bảng dò a21
  ma = "/" ma & "/"
Next ma
' vòng lặp sau đây duyệt bảng a1, tách ra từng mã con, và dò với wildcards trong bảng dò (a21)
For i = 1 To UBound(a1) ' duyệt bảng a1
  For Each ma in Split(a1(i, 2), "/") ' tách ra từng mã
    rwMatch = Apllication.Match("*/" & ma & "/*", a21, 0) ' xét bảng dò
    Do ' vòng lặp giả dùng để nhảy qua code ghi dữ liệu vào b
      If IsError(rwMatch) Then Exit Do
      If rwb > 0 Then ' xét xem mã này đã ghi chưa (lộn xộn vậy đó)
        If b(rwb, 2) = ma And b(rwb, 4) = a2(rwMatch, 1) Then Exit Do
      End If
      rwb = rwb + 1
      b(rwb, 1) = a1(i, 1)
      b(rwb, 2) = a1(i, 2)
      b(rwb, 3) = a1(i, 3)
      b(rwb, 4) = a2(rwMatch, 1)
      b(rwb, 5) = a2(rwMatch, 2)
    Loop
  Next ma
Next i
' code gán rwb dòng của b vào bảng tính

Shaa · 22/11/23

HUONGHCKT đã viết:

Trong khi chờ các giải pháp khác, hãy thử tham khảo code sau (làm theo ý hiểu của tôi)

Mã:

Option Explicit

Sub SHa()
Dim i&, j&, Lr&, Lr1&, t
Dim Arr(), Arr2(), KQ(), S, Tmp
Dim Dic As Object, key, Temp
Dim Sh As Worksheet, Ws As Worksheet
Set Sh = Sheets("DuLieu")
Lr = Sh.Cells(Rows.Count, 1).End(3).Row
Arr = Sh.Range("A4:C" & Lr).Value
Set Dic = CreateObject("Scripting.Dictionary")
ReDim KQ(1 To UBound(Arr), 1 To 6)
For i = 1 To UBound(Arr)
    S = Split(Arr(i, 2), "/")
    For j = 0 To UBound(S)
        key = Arr(i, 1) & "#" & S(j)
            If Not Dic.Exists(key) Then
                Dic(key) = i
            End If
    Next j
Next i

Lr1 = Sh.Cells(Rows.Count, 5).End(3).Row
Arr2 = Sh.Range("E4:G" & Lr).Value
    For i = 1 To UBound(Arr2)
        Tmp = Split(Arr2(i, 2), "/")
        For j = 0 To UBound(Tmp)
            Temp = Arr2(i, 1) & "#" & Tmp(j)
            If Dic.Exists(Temp) Then
                t = t + 1
                KQ(t, 1) = Arr2(i, 1)
                KQ(t, 2) = Arr(Dic(Temp), 2)
                KQ(t, 3) = Arr(Dic(Temp), 3)
                KQ(t, 4) = Arr2(i, 2)
                KQ(t, 5) = Arr2(i, 3)
                KQ(t, 6) = KQ(t, 3) - KQ(t, 5)
                Exit For
            End If
        Next j
    Next i
Set Ws = Sheets("KetQua")
    If t Then
        Ws.Range("A12").Resize(1000, 6).ClearContents
        Ws.Range("A12").Resize(t, 6) = KQ
    End If
Set Dic = Nothing
End Sub

Em cảm ơn anh rất nhiều ạ,
Em thử qua thấy kết quả đúng rồi ạ
Em sẽ kiểm tra với toàn bộ dữ liệu xem sao ạ

Bài đã được tự động gộp: 22/11/23

VetMini đã viết:

Nếu mã xuất hiện nhiều lần trong 1 bảng thì sao?
Giả sử chuyện ấy không xảy ra.

Mã:

' code lấy bảng 1 vào array a1, 3 cột
' code lấy bảng 2 vào array a2, 2 cột
' code lấy mã ở bảng 2 vào array a21, 1 cột để làm bảng dò
Dim b(1 To Rows.Count, 1 To 5) ' dữ liệu quá phức tạp, khó ước lượng đầu ra
For Each ma in A21 ' chuẩn bị bảng dò a21
  ma = "/" ma & "/"
Next ma
' vòng lặp sau đây duyệt bảng a1, tách ra từng mã con, và dò với wildcards trong bảng dò (a21)
For i = 1 To UBound(a1) ' duyệt bảng a1
  For Each ma in Split(a1(i, 2), "/") ' tách ra từng mã
    rwMatch = Apllication.Match("*/" & ma & "/*", a21, 0) ' xét bảng dò
    Do ' vòng lặp giả dùng để nhảy qua code ghi dữ liệu vào b
      If IsError(rwMatch) Then Exit Do
      If rwb > 0 Then ' xét xem mã này đã ghi chưa (lộn xộn vậy đó)
        If b(rwb, 2) = ma And b(rwb, 4) = a2(rwMatch, 1) Then Exit Do
      End If
      rwb = rwb + 1
      b(rwb, 1) = a1(i, 1)
      b(rwb, 2) = a1(i, 2)
      b(rwb, 3) = a1(i, 3)
      b(rwb, 4) = a2(rwMatch, 1)
      b(rwb, 5) = a2(rwMatch, 2)
    Loop
  Next ma
Next i
' code gán rwb dòng của b vào bảng tính

Vâng, sẽ không xuất hiện nhiều lần anh ạ,
Em rất cảm ơn những gợi ý của anh, em sẽ tìm hiểu thêm về cách viết ạ

Nhờ giúp đỡ code so sánh 2 bảng

Shaa

Thành viên mới

File đính kèm

HUONGHCKT

Zalo 0986997214

VetMini

Ăn cùng góc phố

Shaa

Thành viên mới

Bài viết mới nhất

Thành viên có số lượng bài viết cao nhất tháng

Thành viên có điểm tương tác cao nhất tháng