Tìm dữ liệu trùng từ 2 cột thì lây tiêu đề cột đó (1 người xem)

[phihndhsp]

Tôi có 1 thắc mắt mà làm không ra, rất mong các cao thủ cho ý kiến dùm

tôi có 1 bảng dòng đầu là mã hàng

những dòng còn lại là nguyên liệu làm ra mã hàng (ở dòng đầu)
bây giờ tôi muốn lọc ra những con nguyên liệu có mà nó thuộc 2 mã hàng trở lên và lây được mã hàng mà nó hiện diện ở đó
giải thích thì hơi rườm rà nên mong các cao thủ xem file đính kèm
xin cảm ởn nhiều
Trong ví dụ này
A02 thuộc mã hàng là A và C
A02 A
A02 C (Trong file ghi lộn là B)
B01 thuộc mã hàng là A và B
B01 A
B01 B

 

[Ba Tê]

Tôi có 1 thắc mắt mà làm không ra, rất mong các cao thủ cho ý kiến dùm

tôi có 1 bảng dòng đầu là mã hàng

những dòng còn lại là nguyên liệu làm ra mã hàng (ở dòng đầu)
bây giờ tôi muốn lọc ra những con nguyên liệu có mà nó thuộc 2 mã hàng trở lên và lây được mã hàng mà nó hiện diện ở đó
giải thích thì hơi rườm rà nên mong các cao thủ xem file đính kèm
xin cảm ởn nhiều
Trong ví dụ này
A02 thuộc mã hàng là A và C
A02 A
A02 C (Trong file ghi lộn là B)
B01 thuộc mã hàng là A và B
B01 A
B01 B

Thử với Code "củ chuối" này xem:

Public Sub GPE()
Dim Rng As Range, Clls As Range, Arr(), K As Long
    Set Rng = Sheet1.Range(Sheet1.[A3], Sheet1.[A65000].End(xlUp)).Resize(, 3)
ReDim Arr(1 To Rng.Cells.Count, 1 To 2)
    For Each Clls In Rng
        If Application.WorksheetFunction.CountIf(Rng, Clls) > 1 Then
            K = K + 1
            Arr(K, 1) = Clls.Value
            Arr(K, 2) = Cells(2, Clls.Column).Value
        End If
    Next
    Sheet1.[H4:I1000].ClearContents
        If K then Sheet1.[H4].Resize(K, 2).Value = Arr
    Sheet1.[H4].Resize(K, 2).Sort Key1:=Range("H4"), Key2:=Range("I4")
Set Rng = Nothing
End Sub

 

[phihndhsp]

Cảm ơn bác BATE nhiều, tôi test thấy chạy rất tốt, tôi sẽ áp dụng vào bài, tôi sẽ cố gắng hoàn thiện lại code của bác để bác không còn nói câu "Thử với Code "củ chuối" xin cảm ơn

 

[ndu96081631]

Thử với Code "củ chuối" này xem:

Public Sub GPE()
Dim Rng As Range, Clls As Range, Arr(), K As Long
    Set Rng = Sheet1.Range(Sheet1.[A3], Sheet1.[A65000].End(xlUp)).Resize(, 3)
ReDim Arr(1 To Rng.Cells.Count, 1 To 2)
    For Each Clls In Rng
        If Application.WorksheetFunction.CountIf(Rng, Clls) > 1 Then
            K = K + 1
            Arr(K, 1) = Clls.Value
            Arr(K, 2) = Cells(2, Clls.Column).Value
        End If
    Next
    Sheet1.[H4:I1000].ClearContents
        If K then Sheet1.[H4].Resize(K, 2).Value = Arr
    Sheet1.[H4].Resize(K, 2).Sort Key1:=Range("H4"), Key2:=Range("I4")
Set Rng = Nothing
End Sub

Ba Tê dùng COUNTIF e rằng không ổn ---> Một nguyên liệu xuất hiện 2 lần trên 1 cột thì đâu có tính nhỉ?

 

[phihndhsp]

Dạ em thấy code này ổn rồi, vì dữ liệu trên 1 cột không bao giờ giống nhau. Em đã chuyển và thay đổi code vào bài thực tế có vài thay đổi nhưng chạy rất ổn định(tới tận bây giờ)" vì khách hàng không cho đưa dữ liệu lên diễn đàn nên em không dám đưa lên cho mọi người tham khảo" . Một lần nữa xin cảm ơn diễn đàn