Giúp đỡ VBA: Tìm các thành phần bị cấm cho sản phẩm

[AnhNQT]

Xin chào các bác GPE.
Em có các sản phẩm "viết tắt: sp" (cột B) và mã sp (cột B) khác nhau. Đi kèm theo từng sp là các thành phần, các thành phần được liệt kê trong cùng 1 ô.
Và em có danh sách các thành phần bị cấm (sheet TP Bi Cam).
>> Em nhờ các bác GPE viết giúp em VBA thực hiện "Tìm trong các thành phần của sp đó xem có thành phần nào bị cấm" (Kết quả trả về ở cột D)
Em có đính kèm file nhờ các bác giúp ạ, em cảm ơn!

 

[Huyyeu99999]

Xin chào các bác GPE.
Em có các sản phẩm "viết tắt: sp" (cột B) và mã sp (cột B) khác nhau. Đi kèm theo từng sp là các thành phần, các thành phần được liệt kê trong cùng 1 ô.
Và em có danh sách các thành phần bị cấm (sheet TP Bi Cam).
>> Em nhờ các bác GPE viết giúp em VBA thực hiện "Tìm trong các thành phần của sp đó xem có thành phần nào bị cấm" (Kết quả trả về ở cột D)
Em có đính kèm file nhờ các bác giúp ạ, em cảm ơn!

Viết code trong vba thì mình bó tay nhưng cái chương trình mình mới poss có thể giúp ích cho bạn đấy. Nó thiên về tổng hợp, lọc, báo cáo.

 

[AnhNQT]

Mình muốn dùng VBA vì mỗi ngày phải tìm những thành phần bị cấm kia ở sản phẩm. Mà có khoảng 20-30 thành phần bị cấm và tăng lên nữa và có khoảng 300 sản phẩm khác nhau.
Mỗi lần nhận danh sách đó là mình phải copy và lọc ở cột thành phần xem sp nào bị dính và đánh dấu lại. Như vậy mình sẽ phải lọc từng đấy lần theo số lượng thành phần bị cấm! (

 

[Huyyeu99999]

 

[VetMini]

Bài này viết VBA cũng không khó lắm. Nhưng nếu là tôi thì sẽ lập luôn 20-30 cột các thành phần bị cấm (copy, paste transpose). Dùng công thức Search để biết có dính hay không. Và tổng kết lại.
(tôi thì thích phân tích theo kiểu có hệ thống, lớp lang. Cốt kiếc là điều cực chẳng đã mới làm)

 

[AnhNQT]

Bài này viết VBA cũng không khó lắm. Nhưng nếu là tôi thì sẽ lập luôn 20-30 cột các thành phần bị cấm (copy, paste transpose). Dùng công thức Search để biết có dính hay không. Và tổng kết lại.
(tôi thì thích phân tích theo kiểu có hệ thống, lớp lang. Cốt kiếc là điều cực chẳng đã mới làm)

Bác đã đọc hiểu bài em rồi, xin nhờ Bác viết giúp!

 

[CHAOQUAY]

Xin chào các bác GPE.
Em có các sản phẩm "viết tắt: sp" (cột B) và mã sp (cột B) khác nhau. Đi kèm theo từng sp là các thành phần, các thành phần được liệt kê trong cùng 1 ô.
Và em có danh sách các thành phần bị cấm (sheet TP Bi Cam).
>> Em nhờ các bác GPE viết giúp em VBA thực hiện "Tìm trong các thành phần của sp đó xem có thành phần nào bị cấm" (Kết quả trả về ở cột D)
Em có đính kèm file nhờ các bác giúp ạ, em cảm ơn!

Tham khảo đoạn code dưới đây.

Sub Loc()
Dim Chatcam
Dim Nguon
Dim Kq
Dim i, j, k
Chatcam = Sheet2.Range("A1").CurrentRegion
Nguon = Sheet1.Range("A1").CurrentRegion
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(Chatcam)
        .Add Chatcam(i, 2), Chatcam(i, 1)
    Next i
    k = UBound(Nguon)
    ReDim Kq(1 To k - 1, 1 To 1)
    For i = 2 To k
        For Each j In Split(Nguon(i, 3), ",")
            If .exists(Trim(j)) Then
                Kq(i - 1, 1) = Kq(i - 1, 1) & " " & .Item(Trim(j))
            End If
        Next j
        If Len(Kq(i - 1, 1)) = 0 Then
            Kq(i - 1, 1) = "OK"
        Else
            Kq(i - 1, 1) = Replace(Trim(Kq(i - 1, 1)), " ", ", ")
        End If
    Next i
End With
Sheet1.Range("D2:D" & k).ClearContents
Sheet1.Range("D2:D" & k) = Kq
End Sub

 

[HieuCD]

Tham khảo đoạn code dưới đây.

Sub Loc()
Dim Chatcam
Dim Nguon
Dim Kq
Dim i, j, k
Chatcam = Sheet2.Range("A1").CurrentRegion
Nguon = Sheet1.Range("A1").CurrentRegion
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(Chatcam)
        .Add Chatcam(i, 2), Chatcam(i, 1)
    Next i
    k = UBound(Nguon)
    ReDim Kq(1 To k - 1, 1 To 1)
    For i = 2 To k
        For Each j In Split(Nguon(i, 3), ",")
            If .exists(Trim(j)) Then
                Kq(i - 1, 1) = Kq(i - 1, 1) & " " & .Item(Trim(j))
            End If
        Next j
        If Len(Kq(i - 1, 1)) = 0 Then
            Kq(i - 1, 1) = "OK"
        Else
            Kq(i - 1, 1) = Replace(Trim(Kq(i - 1, 1)), " ", ", ")
        End If
    Next i
End With
Sheet1.Range("D2:D" & k).ClearContents
Sheet1.Range("D2:D" & k) = Kq
End Sub

Có khả năng dữ liệu "Đường trắng" hoặc "đường trắng"

 

[CHAOQUAY]

@AnhNQT : Nếu ký tự trong bài của bạn không phân biệt hoa thường thì thêm như sau:
Tìm dòng

With CreateObject("Scripting.Dictionary")

Chèn thêm dòng dưới đây vào bên dưới

.CompareMode = vbTextCompare

 

[VetMini]

Có khả năng dữ liệu "Đường trắng" hoặc "đường trắng"

Từ đầu, chính đề bài đã không chuẩn rồi. Phân tích kiểu này chỉ cần dữ liệu hơi lệch tí là sai bấy.
Mà cái sai này lại theo chiều hướng tai hại. Nếu không dò được nguy hiểm trong lời khai của cá nhân thì coi như cá nhân vô hại?

Bảng dò đáng lẽ phải tự nêu tất cả các trường hợp khai báo khác nhau của một món hàng. Ví dụ: "đường trắng" và "đường cát trắng".
Hoặc bên khai báo phải theo đúng một quy trình. Ví dụ: tất cả các đường dưới dạng trắng (kể cả loại đường rắc trên mặt bánh? đường bột, tiếng Anh là caster sugar) đều phải khai chuẩn là "đường trắng"

 

[AnhNQT]

Tham khảo đoạn code dưới đây.

Sub Loc()
Dim Chatcam
Dim Nguon
Dim Kq
Dim i, j, k
Chatcam = Sheet2.Range("A1").CurrentRegion
Nguon = Sheet1.Range("A1").CurrentRegion
With CreateObject("Scripting.Dictionary")
    For i = 2 To UBound(Chatcam)
        .Add Chatcam(i, 2), Chatcam(i, 1)
    Next i
    k = UBound(Nguon)
    ReDim Kq(1 To k - 1, 1 To 1)
    For i = 2 To k
        For Each j In Split(Nguon(i, 3), ",")
            If .exists(Trim(j)) Then
                Kq(i - 1, 1) = Kq(i - 1, 1) & " " & .Item(Trim(j))
            End If
        Next j
        If Len(Kq(i - 1, 1)) = 0 Then
            Kq(i - 1, 1) = "OK"
        Else
            Kq(i - 1, 1) = Replace(Trim(Kq(i - 1, 1)), " ", ", ")
        End If
    Next i
End With
Sheet1.Range("D2:D" & k).ClearContents
Sheet1.Range("D2:D" & k) = Kq
End Sub

cảm ơn bác rất nhiều, code chạy đúng ý em rồi