如何根据父子关系进行编号

wxh_wf

名称        父        序号
A                0
B        A        1
C        A        2
D        C        2.1
E        C        2.2
F        E        2.2.1
如上表，如何根据A列与父列的关系，编写出C列的编码

amazeyeli

http://club.excelhome.net/thread-1112665-1-1.html

https://mp.weixin.qq.com/s?__biz ... Ibx0YlXHSkTMjK2W#rd

wxh_wf

谢谢大神，不过这两个链接和我的问题不一样啊！

一把小刀闯天下

wxh_wf 发表于 2018-8-5 18:31
谢谢大神，不过这两个链接和我的问题不一样啊！

A		0		0
B	A	1		0.1
C	A	2		0.2
D	C	2.1		0.2.1
E	C	2.2		0.2.2
F	E	2.2.1		0.2.2.1

'根为0，所以你这示例图有问题，因为根都丢了

'当然你也可以对输出结果作简单替换，，，

Option Explicit

Sub test()
  Dim arr, i
  ReDim dic(1 To 2)
  For i = 1 To UBound(dic)
    Set dic(i) = CreateObject("scripting.dictionary")
  Next
  arr = [a1].CurrentRegion
  ReDim brr(1 To UBound(arr, 1), 1 To 1)
  For i = 1 To UBound(arr, 1)
    If Len(arr(i, 2)) = 0 Then
      brr(i, 1) = 0: dic(1)(arr(i, 1)) = 0: dic(2)(arr(i, 1)) = 0
    Else
      If dic(1).exists(arr(i, 2)) Then
        dic(1)(arr(i, 2)) = dic(1)(arr(i, 2)) + 1
        brr(i, 1) = dic(2)(arr(i, 2)) & "." & dic(1)(arr(i, 2))
        dic(1)(arr(i, 1)) = 0: dic(2)(arr(i, 1)) = brr(i, 1)
      End If
    End If
  Next
  [e1].Resize(UBound(arr, 1)) = brr
End Sub