Nhờ giúp đỡ code lọc dữ liệu duy nhất có điều kiện

[Eric.Shen]

Chào các bác,
Em đang có một bài toán như sau:
Cùng một mã sản phẩm có thể có các mã liệu giống nhau được đặt cùng dòng và cách nhau bởi dấu "/"
Tuy nhiên thứ tự các mã liệu này lại không giống nhau giữa các dòng
Ví dụ: A1/A2/A3 và A2/A3/A1 có thứ tự xếp không giống nhau nhưng bản chất là một và em chỉ cần xuất hiện 1 trong 2
Vậy em nhờ các bác giúp em một code có thể lọc ra duy nhất với ạ
Chi tiết em để trong tệp đính kèm
Em cảm ơn ạ

 

[bebo021999]

Xài đỡ code này nhé bạn

Option Explicit
Sub LocDuyNhat()
Dim lr&, i&, j1&, j2&, k&, rng, arr(), res(), list(), sp
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A4:B" & lr).Value
ReDim arr(1 To UBound(rng), 1 To 2)
ReDim res(1 To 10000, 1 To 2)
For i = 1 To UBound(rng)
    ReDim list(1 To 1)
    For Each sp In Split(rng(i, 2), "/")
        sp = Trim(sp)
        list(UBound(list)) = sp
        ReDim Preserve list(1 To UBound(list) + 1)
    Next
    For j1 = 1 To UBound(list) - 1
        For j2 = j1 + 1 To UBound(list)
            If list(j2) < list(j1) Then
                sp = list(j1)
                list(j1) = list(j2)
                list(j2) = sp
            End If
        Next
    Next
    arr(i, 1) = rng(i, 1) & "|" & Join(list, "/")
Next
For i = 1 To UBound(arr) - 1
    For j1 = i + 1 To UBound(arr)
        If arr(i, 1) = arr(j1, 1) Or InStr(1, arr(j1, 1), arr(i, 1)) Then
            arr(i, 1) = ""
            Exit For
        End If
    Next
Next
For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
        sp = Split(arr(i, 1), "|")
        k = k + 1: res(k, 1) = sp(0)
        res(k, 2) = Mid(Replace(sp(1), "/", " / "), 4, 255)
    End If
Next
Range("D4:E10000").ClearContents
Range("D4").Resize(k, 2).Value = res
End Sub

 

[VetMini]

Đại khái nó như vầy:
(code chỉ đại khái để minh họa giải thuật thôi, chưa chạy thử)

a1 = Vùng dữ liệu ' mảng dữ liệu '
iLast = UBound(a1)
Redim a2(1 To iLast, 1 To 1) ' mảng kết quả '
i2 = 0
For i1 = 1 To iLast
  If a1(i1, 1) <> "" Then '  nếu = "" thì nó vốn là trùng, đã bị xóa '
    i2 = i2 +1
    a2(a2, 1) = a1(i1, 1) ' mã mới, chép vào kết quả '
    For i11 = i1 + 1 To iLast
      If NhuNhau(a1(i1, 1), a1(i11, 1) Then a1(i11, 1) = "" ' trùng -> xóa '
    Next i11
  End If
Next i1

' ------ '
Function NhuNhau(byRef s1, As String, byVal s2 As String) As Boolean
s2 = "/" & w2 & "/"
For Each e In Split("/" & Replace(s1, "/", "/\/") & "/", "\")
' chuyển string "a/b/c" về dạng "/a/\/b/\/c/" rồi split theo "\"
If InsStr(s2, e) < 1 Then Exit Function
Next e
NhuNhau = True
End Function

Bổ sung và đính chính:
Code trên không sử dụng được. Nó sai rồi: nhược điểm của tìm InStr là nếu hai chuỗi so sánh khác mã thì nó không nhận ra.
Như vậy chỉ có cách so sánh vét cạn. Mà giải thuật so sánh vét cạn thì nhiều bài viết rồi. Tôi không cần thêm nữa.

 

[Eric.Shen]

Xài đỡ code này nhé bạn

Option Explicit
Sub LocDuyNhat()
Dim lr&, i&, j1&, j2&, k&, rng, arr(), res(), list(), sp
lr = Cells(Rows.Count, "A").End(xlUp).Row
rng = Range("A4:B" & lr).Value
ReDim arr(1 To UBound(rng), 1 To 2)
ReDim res(1 To 10000, 1 To 2)
For i = 1 To UBound(rng)
    ReDim list(1 To 1)
    For Each sp In Split(rng(i, 2), "/")
        sp = Trim(sp)
        list(UBound(list)) = sp
        ReDim Preserve list(1 To UBound(list) + 1)
    Next
    For j1 = 1 To UBound(list) - 1
        For j2 = j1 + 1 To UBound(list)
            If list(j2) < list(j1) Then
                sp = list(j1)
                list(j1) = list(j2)
                list(j2) = sp
            End If
        Next
    Next
    arr(i, 1) = rng(i, 1) & "|" & Join(list, "/")
Next
For i = 1 To UBound(arr) - 1
    For j1 = i + 1 To UBound(arr)
        If arr(i, 1) = arr(j1, 1) Or InStr(1, arr(j1, 1), arr(i, 1)) Then
            arr(i, 1) = ""
            Exit For
        End If
    Next
Next
For i = 1 To UBound(arr)
    If arr(i, 1) <> "" Then
        sp = Split(arr(i, 1), "|")
        k = k + 1: res(k, 1) = sp(0)
        res(k, 2) = Mid(Replace(sp(1), "/", " / "), 4, 255)
    End If
Next
Range("D4:E10000").ClearContents
Range("D4").Resize(k, 2).Value = res
End Sub

Em thấy code chạy đúng rồi bác ạ, Em cảm ơn bác rất nhiều ạ
Bác cho em hỏi thêm chút là nếu trường hợp
Dòng 1: A1 / A2
Dòng 2: A1 / A3
Dòng 3: A1 / A2 / A3
Có thể cho nó chỉ lấy cái dòng 3 không ạ

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

Đại khái nó như vầy:
(code chỉ đại khái để minh họa giải thuật thôi, chưa chạy thử)

a1 = Vùng dữ liệu ' mảng dữ liệu '
iLast = UBound(a1)
Redim a2(1 To iLast, 1 To 1) ' mảng kết quả '
i2 = 0
For i1 = 1 To iLast
  If a1(i1, 1) <> "" Then '  nếu = "" thì nó vốn là trùng, đã bị xóa '
    i2 = i2 +1
    a2(a2, 1) = a1(i1, 1) ' mã mới, chép vào kết quả '
    For i11 = i1 + 1 To iLast
      If NhuNhau(a1(i1, 1), a1(i11, 1) Then a1(i11, 1) = "" ' trùng -> xóa '
    Next i11
  End If
Next i1

' ------ '
Function NhuNhau(byRef s1, As String, byVal s2 As String) As Boolean
s2 = "/" & w2 & "/"
For Each e In Split("/" & Replace(s1, "/", "/\/") & "/", "\")
' chuyển string "a/b/c" về dạng "/a/\/b/\/c/" rồi split theo "\"
If InsStr(s2, e) < 1 Then Exit Function
Next e
NhuNhau = True
End Function

Vâng, e cảm ơn bác nhiều ạ
Em sẽ nghiệm thử ạ

 

[Maika8008]

Em thấy code chạy đúng rồi bác ạ, Em cảm ơn bác rất nhiều ạ
Bác cho em hỏi thêm chút là nếu trường hợp
Dòng 1: A1 / A2
Dòng 2: A1 / A3
Dòng 3: A1 / A2 / A3
Có thể cho nó chỉ lấy cái dòng 3 không ạ

Tôi thấy yêu cầu này rất phi quy tắc. Mà hình như sẽ phát sinh nữa chứ chưa hết.

 

[Eric.Shen]

Tôi thấy yêu cầu này rất phi quy tắc. Mà hình như sẽ phát sinh nữa chứ chưa hết.

vâng ạ,
Em sẽ tách nó thành khác nhau vậy ạ, vì đúng như bác nói ạ, nó không có nguyên tắc cụ thể
Em cảm ơn các bác nhiều ạ

 

[bebo021999]

Em thấy code chạy đúng rồi bác ạ, Em cảm ơn bác rất nhiều ạ
Bác cho em hỏi thêm chút là nếu trường hợp
Dòng 1: A1 / A2
Dòng 2: A1 / A3
Dòng 3: A1 / A2 / A3
Có thể cho nó chỉ lấy cái dòng 3 không ạ

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

Vâng, e cảm ơn bác nhiều ạ
Em sẽ nghiệm thử ạ

Tôi thấy yêu cầu này rất phi quy tắc. Mà hình như sẽ phát sinh nữa chứ chưa hết.

Cũng coi như là có quy tắc đấy chứ.
Dòng 1: A1 và A2 có thể tìm thấy đầy đủ trong dòng 3: Xóa dòng 1
Dòng 2: A1 và A3 có thể tìm thấy đầy đủ trong dòng 3: Xóa dòng 2
Dòng 3: Là dòng đầy đủ nên giữ lại.
Nếu bạn gửi lại file ví dụ đầy đủ nhất (nếu file thực đang làm thì tốt nhất, vì các A1,A2,A3 có thể là các ký tự khác) thì tôi sẽ thử viết lại code xem sao.
Đằng nào code vừa rồi tôi cũng chưa hài lòng lắm về nó!

 

[Eric.Shen]

Cũng coi như là có quy tắc đấy chứ.
Dòng 1: A1 và A2 có thể tìm thấy đầy đủ trong dòng 3: Xóa dòng 1
Dòng 2: A1 và A3 có thể tìm thấy đầy đủ trong dòng 3: Xóa dòng 2
Dòng 3: Là dòng đầy đủ nên giữ lại.
Nếu bạn gửi lại file ví dụ đầy đủ nhất (nếu file thực đang làm thì tốt nhất, vì các A1,A2,A3 có thể là các ký tự khác) thì tôi sẽ thử viết lại code xem sao.
Đằng nào code vừa rồi tôi cũng chưa hài lòng lắm về nó!

Vâng ạ,
Thực tế em cần làm là một bảng so sánh cuối cùng, nhưng sợ nó phức tạp quá, nên hôm qua em mới nhờ bác một đoạn phía trước
Em có giải thích lại các mong muốn ở bên trong file đính kèm ạ,
Bác xem giúp em có cách nào xử lý giúp em không với nhé
Em cảm ơn ạ

 

[VetMini]

Tôi thấy yêu cầu này rất phi quy tắc. Mà hình như sẽ phát sinh nữa chứ chưa hết.

Không hẳn phi quy tắc.
Nhưng giải thuật cần thay đổi. Giải thuật trước mắt mà tôi thấy là phải sort dữ liệu theo dộ dài chuỗi, từ dài đến ngắn.

Chú thích: nếu array đã sort thì giải thuật InStr ở bài #3 lại có khả năng dùng được.

 

[bebo021999]

Vâng ạ,
Thực tế em cần làm là một bảng so sánh cuối cùng, nhưng sợ nó phức tạp quá, nên hôm qua em mới nhờ bác một đoạn phía trước
Em có giải thích lại các mong muốn ở bên trong file đính kèm ạ,
Bác xem giúp em có cách nào xử lý giúp em không với nhé
Em cảm ơn ạ

Sai lầm của người hỏi: Sợ phức tạp quá nên tách yêu cầu làm nhiều phần. Tuy nhiên nhiều phần riêng rẽ, sau khi giải quyết xong, khi ráp lại thì chẳng ra cái gì cả.
Sai lầm của người giúp: khi nhìn vào yêu cầu cụ thể của người hỏi, mà không phán đoán và nhìn rộng ra. Và mất quá nhiều thời gian vô ích.
Giống như trường hợp dây chuyền lắp ráp xe đạp.
Bánh trước và bánh sau, có những phụ tùng giống nhau (niềng, căm, vỏ, ruột) và khác nhau (đùm, đĩa, nhông...)
Khi quan tâm đến nguồn cung NVL căm xe (nan hoa...) của cái bánh trước, phải xét đồng thời với cái bánh sau, vì nó cùng loại NVL.
Và khi liệt kê NVL để s/x ra cái xe đạp, "căm" chỉ được liệt kê ra 1 lần mà thôi.
Cụ thể, ví dụ của bạn, mấu chốt vấn đề là:
Mỗi loại danh mục hàng hóa cuối cùng, sẽ chỉ bao gồm các loại NVL duy nhất mà thôi.

 

[Eric.Shen]

V

Sai lầm của người hỏi: Sợ phức tạp quá nên tách yêu cầu làm nhiều phần. Tuy nhiên nhiều phần riêng rẽ, sau khi giải quyết xong, khi ráp lại thì chẳng ra cái gì cả.
Sai lầm của người giúp: khi nhìn vào yêu cầu cụ thể của người hỏi, mà không phán đoán và nhìn rộng ra. Và mất quá nhiều thời gian vô ích.
Giống như trường hợp dây chuyền lắp ráp xe đạp.
Bánh trước và bánh sau, có những phụ tùng giống nhau (niềng, căm, vỏ, ruột) và khác nhau (đùm, đĩa, nhông...)
Khi quan tâm đến nguồn cung NVL căm xe (nan hoa...) của cái bánh trước, phải xét đồng thời với cái bánh sau, vì nó cùng loại NVL.
Và khi liệt kê NVL để s/x ra cái xe đạp, "căm" chỉ được liệt kê ra 1 lần mà thôi.
Cụ thể, ví dụ của bạn, mấu chốt vấn đề là:
Mỗi loại danh mục hàng hóa cuối cùng, sẽ chỉ bao gồm các loại NVL duy nhất mà thôi.

Vâng, em sẽ chú ý hơn trong việc trình bày.
Bác nói đúng ạ, lấy duy nhất và nằm trong tập hợp đầy đủ nhất rồi nhặt ra so sánh với nhau ạ

 

[bebo021999]

Các ô màu vàng: Từ bảng 1 sang bảng 3: C chuyển thành B?
Nếu là C, thì thì C1 xuất hiện 2 lần?

 

[Eric.Shen]

Các ô màu vàng: Từ bảng 1 sang bảng 3: C chuyển thành B?
Nếu là C, thì thì C1 xuất hiện 2 lần?

View attachment 296089

Em xin lỗi ạ,
Chỗ đó không phải C1 đâu ạ
Em sửa lại thành C5 ạ

 

[bebo021999]

Em xin lỗi ạ,
Chỗ đó không phải C1 đâu ạ
Em sửa lại thành C5 ạ

Đang hỏi dòng trên mà? Từ A10 qua I8.

 

[Eric.Shen]

Đang hỏi dòng trên mà? Từ A10 qua I8.

À, chỗ đó vẫn là Sản Phẩm C bác ạ
bác sửa lại giúp em nhé