如何查找父子关系

爱疯

1.rar (18.4 KB, 下载次数: 15)

2015-9-15 17:43 上传

点击文件名下载附件



Dim Zi As Object
Sub test()
    Dim A, B, i%, Fu As Object

    '1）数据源。A列是子，B列是父
    A = Range("a1").CurrentRegion.Value

    '2）创建字典
    Set Fu = CreateObject("scripting.dictionary")
    Set Zi = CreateObject("scripting.dictionary")
    For i = 2 To UBound(A)
        Fu(A(i, 2)) = A(i, 1)    '在Fu字典里，key是父，item是子
        Zi(A(i, 1)) = A(i, 2)    '在Zi字典里，key是子，item是父
    Next i

    '2）找出子的上层的父
    B = Zi.keys
    For i = 0 To UBound(B)
        B(i) = Mid(f(B(i)), 2)
    Next i

    '输出
    Columns("E:Z").ClearContents
    [E2].Resize(i) = Application.Transpose(B)
End Sub

'递归查询
Function f(x)
    If Zi.exists(Zi(x)) Then    'x是子，Zi(x)是x的父。因此这里是判断，子x的父亲是不是子？
        f = f(Zi(x)) & ">"    '累计上层的父
    Else
        f = Zi(x) & ">"    '到达顶端
    End If
    f = f & x
End Function



需求：返回每个人的所有的上层推荐人。
1）一父有一子，是对的。
     一父有多子，也是对的。
     一子有多父，只承认最早一个关系。
2）如果不递归，好实现么？
希望就此相关问题，讨论学习。谢谢！

上清宫主

查父子关系得找娃他妈，要不然只有验DNA
玩笑话！

这是考数据结构和算法吗？到那里面查查树的遍列

爱疯

上清宫主 发表于 2015-9-15 13:47
查父子关系得找娃他妈，要不然只有验DNA
玩笑话！

只是想把这种题整理一下，以后好解决同类问题。对于这类问题，怎样的思路比较合理，如果不是碰巧想到一个方法，自己对此，也是比较手忙脚乱，无从下手的。。。。

pengyx

有子必有父，找到父，父变子。找不到父loop

爱疯

pengyx 发表于 2015-9-15 17:12
有子必有父，找到父，父变子。找不到父loop

谢谢 pengyx！

父变子，不大懂。。。。
找不到父跳出，是对于错误的情况的处理么？

金樽空对月

没看懂，等以后水平提高了再回来看看，先收藏了再说{:35:}

pengyx

爱疯 发表于 2015-9-15 17:16
谢谢 pengyx！

父变子，不大懂。。。。

Sub pengyx()
rw = [a65536].End(3).Row
rz = Range("a2:a" & rw)
rf = Range("b2:b" & rw)
ReDim ar(1 To UBound(rz), 1 To 1)
For i = 1 To UBound(rz)
    s = rf(i, 1)
    ar(i, 1) = rz(i, 1)
    While s <> ""
        For j = 1 To UBound(rz)
            If rz(j, 1) = s Then
                ar(i, 1) = rz(j, 1) & ">" & ar(i, 1)
                s = rf(j, 1)
                Exit For
            End If
        Next
        If j = UBound(rz) Then s = ""
    Wend
Next
Range("f2").Resize(UBound(rz), 1) = ar
End Sub
几句代码，真没必要定义变量，你把字母用完了，我都找不到用的了

爱疯

pengyx 发表于 2015-9-16 13:43
Sub pengyx()
rw = [a65536].End(3).Row
rz = Range("a2:a" & rw)

Sub pengyx()
    rw = [a65536].End(3).Row
    rz = Range("a2:a" & rw)
    rf = Range("b2:b" & rw)
    ReDim ar(1 To UBound(rz), 1 To 1)

    '有子必有父：基于"若无父，子是（顶层的）父"的规则。
    For i = 1 To UBound(rz)
        s = rf(i, 1)
        '提前写入，很可能重写。
        ar(i, 1) = rz(i, 1)

        '若变量s<>""，则循环
        While s <> ""
            For j = 1 To UBound(rz)
                '父如果同时也是子
                If rz(j, 1) = s Then
                    '父ar(i, 1)变为子,并将之前统计累计到ar(i,1)：父的父 > 父
                    ar(i, 1) = rz(j, 1) & ">" & ar(i, 1)
                    '指定变量s = 父的父
                    s = rf(j, 1)
                    Exit For
                End If
            Next
            '强制j不出错
            If j = UBound(rz) Then s = ""
        Wend
    Next
    Range("f2").Resize(UBound(rz), 1) = ar
End Sub
8.rar (40.29 KB, 下载次数: 18)

2015-9-16 17:34 上传

点击文件名下载附件

谢谢pengyx！
学习后按自己的理解，只能注释这样了，不知是否合适？
在pengyx()中， i=8 时，单步测试，exit for后，继续再找，有一点了感觉。
但自己对2个橙色的位置，仍理解的不是很清晰。
我觉得，自己这样想的很少，理解就迟钝，还得多做，多这么想。。。









另外，2个粉圈处（F2，F13）
个人觉得结果"A>A"，相对于"A"，很可能是一种错误表达方式。
所以，宁可出错，暴露出来，好让用户发现，是数据源的错误。
不知这个看法，是否合理？







Sub pengyx()
    rw = [a65536].End(3).Row
    rz = Range("a2:a" & rw)
    rf = Range("b2:b" & rw)
    ReDim ar(1 To UBound(rz), 1 To 1)
    For i = 1 To UBound(rz)
        s = rf(i, 1)
        ar(i, 1) = rz(i, 1)    '如果父无子，直接产生结果
        While s <> ""    '当父有子时
            For j = 1 To UBound(rz)
                If rz(j, 1) = s Then    '如果父有子
                    ar(i, 1) = rz(j, 1) & ">" & ar(i, 1)    '关系 = 关系>子
                    s = rf(j, 1)    '子变父
                    Exit For    '重新开始判断
                End If
            Next
            'If j = UBound(rz) Then s = "" '如果数据都正确，可注释
        Wend
    Next
    Range("f2").Resize(UBound(rz), 1) = ar
End Sub

wanao2008

我也写了个查找代码，因为是新手，写的不好，见笑
我用倒查法，For 循环嵌套 Do 再嵌套 For，效果挺好的

1. Sub findDad()
   
2. Dim guanXi As String, Fu As String, Zi As String
   
3. For x = Range("A65536").End(xlUp).Row To 2 Step -1
   
4. guanXi = ""
   
5. Zi = Cells(x, 1)
   
6. Fu = Cells(x, 2)
   
7. If Fu <> "" Then
   
8. Do
   
9. If guanXi = "" Then guanXi = Zi & ">" & Fu Else guanXi = guanXi & ">" & Fu
   
10. For i = 2 To x
    
11. If Cells(i, 1) = Fu Then Fu = Cells(i, 2): Exit For
    
12. If Fu = "" Then Exit Do
    
13. Next
    
14. Loop
    
15. Else
    
16. guanXi = Zi
    
17. End If
    
18. Cells(x, 3) = guanXi
    
19. Next
    
20. End Sub

复制代码

爱疯

只发现这样一个错误，9楼会死循环。
For i = 2 To x
改为
For i = 2 To Range("A65536").End(xlUp).Row
就好了，其它修改不重要，注释是自己的理解。


Sub findDad()
    Dim A, guanXi As String, Fu As String, Zi As String, i, j
    A = Range("A1:c" & Cells(Rows.Count, 1).End(3).Row)
   
    For i = 2 To UBound(A)
        guanXi = "": Zi = A(i, 1): Fu = A(i, 2)

        If Fu <> "" Then
            Do Until Fu = ""
                '2）记录关系：或 父>子，或 父>关系
                If guanXi = "" Then guanXi = Fu & ">" & Zi Else guanXi = Fu & ">" & guanXi
               
                '3）找爷爷
                For j = 2 To UBound(A)
                    If A(j, 1) = Fu Then Fu = A(j, 2): Exit For
                Next
            Loop
        Else
            '1）父是空，最简单，关系就是子
            guanXi = Zi
        End If

        A(i, 3) = guanXi
    Next
   
    [a1].Resize(i - 1, 3) = A
End Sub