查找与姓名a相关的工序号

excelvlookup

每个工序对应3个姓名，查找与姓名a存在直接或间接关系的工序号

excelvlookup

a在数据表中的位置任意

excelvlookup

是太简单，还是太难，或者是没表述清楚？一天了，没一个人回贴。

astupig

我看了一下，你的表述可能还要说清楚一些：
你举的例子可能太少了,间接关系最多有多少重？
比如， a通过b通过d通过e通过g通过h通过找到i,q ？
你四万多数据，可能有十几重关系。 这种是比较烧脑的。要有一定算法基础。

excelvlookup

astupig 发表于 2018-8-30 13:40
我看了一下，你的表述可能还要说清楚一些：
你举的例子可能太少了,间接关系最多有多少重？
比如， a通过b ...

谢谢你的回复，这个在这里难道无解？？？

一把小刀闯天下

'不一定正确，特别是关系式。你这数据量太小了

Option Explicit

Const FINDSTR As String = "a"

Sub test()
  Dim i, j, arr, dic, cnt
  Set dic = CreateObject("scripting.dictionary")
  arr = [a3:e6]
  ReDim brr(1 To UBound(arr, 1) * 2, 1 To 3)
  For i = 1 To UBound(arr, 1)
    brr(i, 1) = arr(i, 1): brr(i, 2) = arr(i, 2): brr(i, 3) = arr(i, 3)
    brr(UBound(arr, 1) + i, 1) = arr(i, 1)
    brr(UBound(arr, 1) + i, 2) = arr(i, 3)
    brr(UBound(arr, 1) + i, 3) = arr(i, 4)
  Next
  For i = 1 To UBound(brr, 1)
    If brr(i, 2) = FINDSTR Then Exit For
  Next
  If i = UBound(brr, 1) + 1 Then MsgBox "!": Exit Sub
  dic(brr(i, 1)) = brr(i, 2) & "->" & brr(i, 3): brr(i, 2) = vbNullString
  Call dfs(brr, brr(i, 3), dic)
  For i = 1 To UBound(arr, 1)
    If dic.exists(arr(i, 1)) Then
      cnt = cnt + 1
      For j = 1 To UBound(arr, 2) - 1: arr(cnt, j) = arr(i, j): Next
      arr(cnt, j) = dic(arr(i, 1))
    End If
  Next
  With [g2] '输出位置自己修改
    .Resize(Rows.Count - 1, UBound(arr, 2)).ClearContents
    .Resize(cnt, UBound(arr, 2)) = arr
  End With
End Sub

Function dfs(arr, s, dic)
  Dim i
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 2)) Then
      If arr(i, 2) = s Then
        If dic.exists(arr(i, 1)) Then
          dic(arr(i, 1)) = dic(arr(i, 1)) & "->" & arr(i, 3)
        Else
          dic(arr(i, 1)) = arr(i, 2) & "->" & arr(i, 3)
        End If
        Call dfs(arr, arr(i, 3), dic)
      End If
    End If
  Next
End Function

excelvlookup

谢谢代码我需要慢慢消化一下，星期一测试后再把结果返给你，实际上困绕我的就是关系图，一直没有一个好的算法。

excelvlookup

谢谢代码，我消化一下，星期一测试后返结果哈

一把小刀闯天下

有效3列，数据行4万，关系会变得非常复杂，进入死循环是大概率事件

如果不进入死循环可能会丢失很多关联工序号，我没加这条件进去，，，