Tìm tất cả các chuỗi có quan hệ họ hàng với 1 chuỗi gốc

[Le Hieu Liem]

Nhờ các ACE hướng dẫn giúp mình cách xử lý bài toán bên dưới = VBA excel nhé.
Chuỗi 7077369595 là chuỗi gốc cần tìm các chuỗi khác có mối quan hệ với nó
Chuỗi 7077369595 có quan hệ với chuỗi 7078830630
Trong khi chuỗi 7078830630 có quan hệ với chuỗi 7078330635
Như vậy, kết quả cần tìm ra là chuỗi gốc và các chuỗi có liên quan trực tiếp và gián tiếp với chuỗi gốc

 

[BuiQuangThuan]

Nhờ các ACE hướng dẫn giúp mình cách xử lý bài toán bên dưới = VBA excel nhé.
Chuỗi 7077369595 là chuỗi gốc cần tìm các chuỗi khác có mối quan hệ với nó
Chuỗi 7077369595 có quan hệ với chuỗi 7078830630
Trong khi chuỗi 7078830630 có quan hệ với chuỗi 7078330635
Như vậy, kết quả cần tìm ra là chuỗi gốc và các chuỗi có liên quan trực tiếp và gián tiếp với chuỗi gốc
View attachment 289261

Quan hệ là như thế nào thì không thấy nói nhỉ

 

[Hoàng Tuấn 868]

Quan hệ là như thế nào thì không thấy nói nhỉ

Đang kích hoạt khả năng trời cho của các thầy bói.

 

[Le Hieu Liem]

Quan hệ là như thế nào thì không thấy nói nhỉ

Quan hệ theo chiều ngang và quan hệ thông qua tính chất bắt cầu nha bạn
7077369595 quan hệ chuỗi 7078330630 theo chiều ngang
Chuỗi 7078330635 cũng quan hệ với chuỗi 7078330630 theo chiều ngang
Nhưng qua tính chất bắt cầu thì kết quả cho thấy chuỗi 7078330635 cũng có quan hệ với chuỗi gốc 7077369595 thông qua chuỗi 7078330630

 

[VetMini]

Quan hệ là như thế nào thì không thấy nói nhỉ

Nhìn ví dụ thì thấy quan hệ con, cháu, chắt, chít, ... kiểu như folder và subfolders vậy.
Tuy nhiên, kết quả sẽ sắp xếp theo thứ bậc, như vậy làm đệ quy hơi khó. Và nhìn chẳng thấy lô gic.

 

[HieuCD]

Nhờ các ACE hướng dẫn giúp mình cách xử lý bài toán bên dưới = VBA excel nhé.
Chuỗi 7077369595 là chuỗi gốc cần tìm các chuỗi khác có mối quan hệ với nó
Chuỗi 7077369595 có quan hệ với chuỗi 7078830630
Trong khi chuỗi 7078830630 có quan hệ với chuỗi 7078330635
Như vậy, kết quả cần tìm ra là chuỗi gốc và các chuỗi có liên quan trực tiếp và gián tiếp với chuỗi gốc
View attachment 289261

Kết quả theo trực hệ

Sub XYZ()
  Dim arr(), res(), S, dCha As Object, dCon As Object
  Dim sRow&, i&, k&, cha
 
  Set dCha = CreateObject("scripting.dictionary")
  Set dCon = CreateObject("scripting.dictionary")
  arr = Range("A2", Range("B" & Rows.Rows.Count).End(xlUp)).Value
  sRow = UBound(arr)
  ReDim res(1 To sRow * 2, 1 To 2)
  For i = 1 To sRow
    cha = CStr(arr(i, 1))
    dCon(CStr(arr(i, 2))) = cha
    dCha(cha) = dCha(cha) & "|" & arr(i, 2)
  Next i
  For Each cha In dCha.keys
    If dCon.exists(cha) = False Then
      k = k + 1
      res(k, 1) = cha: res(k, 2) = cha
      Call DeQuy(res, dCha, k, cha)
    End If
  Next cha
  Range("E2").Resize(k, 2) = res
End Sub

Sub DeQuy(res, dCha, k, ByVal cha$)
  Dim S, i&
  S = Split(dCha(cha), "|")
  For i = 1 To UBound(S)
    k = k + 1
    res(k, 2) = S(i)
    If dCha.exists(S(i)) Then
      Call DeQuy(res, dCha, k, S(i))
    End If
  Next i
End Sub

 

[bebo021999]

Cái này giống bài toán lập cây phả hệ quá nhỉ?

 

[HieuCD]

Kết quả xếp theo thứ bậc

Sub XYZabc()
  Dim arr(), res(), S, dCha As Object, dCon As Object
  Dim sRow&, i&, k&, cha
 
  Set dCha = CreateObject("scripting.dictionary")
  Set dCon = CreateObject("scripting.dictionary")
  arr = Range("A2", Range("B" & Rows.Rows.Count).End(xlUp)).Value
  sRow = UBound(arr)
  ReDim res(1 To sRow * 2, 1 To 2)
  For i = 1 To sRow
    cha = CStr(arr(i, 1))
    dCon(CStr(arr(i, 2))) = cha
    dCha(cha) = dCha(cha) & "|" & arr(i, 2)
  Next i
  For Each cha In dCha.keys
    If dCon.exists(cha) = False Then
      k = k + 1
      res(k, 1) = cha: res(k, 2) = cha
      Call DeQuy2(res, dCha, k, dCha(cha))
    End If
  Next cha
  Range("E2").Resize(sRow * 2, 2) = res
End Sub

Sub DeQuy2(res, dCha, k, ByVal cha$)
  Dim S, i&, con$
  S = Split(cha, "|")
  For i = 1 To UBound(S)
    k = k + 1
    res(k, 2) = S(i)
    If dCha.exists(S(i)) Then
      con = con & dCha(S(i))
    End If
  Next i
  If con <> Empty Then Call DeQuy2(res, dCha, k, con)
End Sub