使用VBA快速梳理多层级族谱（组织架构）

实例需求：族谱（或者公司组织架构等）都是典型的带有层级关系数据，例如下图中左侧表格所示。

A列为层级（准确的讲是B列成员的层级），从一开始递增
B列和C列为成员直接的父（/母）子（/女）关系
D列为辅助标记

现需要整理为右侧表格的形式，按照每个家族链依次排列，如标记颜色部分所示。

在这里插入图片描述

由于每个层级的成员梳理，层级深度不确定，因此需要使用递归过程实现。

实例代码如下。

Dim arrRes(), iR As Long
Sub Demo()Dim i As Long, j As Long, objDic As ObjectDim arrData, rngData As Range, aRow(1 To 4)Dim sParent As String, sChild As String, sFirst As StringSet rngData = ActiveSheet.Range("A1").CurrentRegionarrData = rngData.ValueReDim arrRes(1 To UBound(arrData), 1 To 4)iR = 1For j = 1 To 4arrRes(iR, j) = arrData(1, j)NextSet objDic = CreateObject("scripting.dictionary")For i = LBound(arrData) To UBound(arrData)If arrData(i, 1) = 1 Then If Len(sFirst) > 0 ThenCall GetChild(objDic, "", sFirst)objDic.RemoveAllEnd IfsFirst = arrData(i, 3)End IfsParent = arrData(i, 2): sChild = arrData(i, 3)If Not objDic.exists(sParent) ThenSet objDic(sParent) = CreateObject("scripting.dictionary")End IfFor j = 1 To 4aRow(j) = arrData(i, j)NextobjDic(sParent)(sChild) = aRow()Next iCall GetChild(objDic, "", sFirst)With ActiveSheet.Range("F1").Resize(iR, 4).EntireColumn.Clear.Value = arrResEnd With
End Sub
Sub GetChild(oDic As Object, sParent As String, sChild As String)Dim vKey, aRow, j As LongaRow = oDic(sParent)(sChild)iR = iR + 1For j = 1 To 4arrRes(iR, j) = aRow(j)NextIf oDic.exists(sChild) ThenFor Each vKey In oDic(sChild).keysCall GetChild(oDic, sChild, vKey)NextEnd If
End Sub

【代码解析】
第1行代码声明模块基本变量，用于保存结果数据。
第2~36行代码为主过程。
第6行代码获取A1开始的当前数据区域。
第7行代码将数据加载到数组中。
第8行代码为结果数组分配存储空间。
第10~12行代码将表头复制到结果数组中。
第13行代码创建字典对象。
第14~30行代码循环处理每行数据。
第15行代码判断当前数据是否为第一级。
如果是的话，第16~20行代码进行相应处理。
第16行代码判断sFirst变量是否为空，如果不为空，说明从该行开始一个新的族系。
第17行代码调用递归过程GetChild()，将objDic对象中保存的族谱整理到结果数组中。
第18行代码清空字典对象。
第20行代码将当前行的C列成员保存到sFirst变量中。
第22行代码分别读取B列和C列数据。
第23行代码判断父成员是否已经存在于字典对象中，如果不存在，第24行代码创建一个嵌套的字典对象。
第26~28行代码将该行4个数据保存到临时数组变量aRow中。
第29行代码将行数据保存到嵌套字典对象中，父成员为外层字典的键，子成员为内层字典的键。
第31行代码作用与第17行相同，用于处理最后一个家族。
第32行代码为结果输出区域Range对象。
第33行代码清空输出区域。
第34行代码将结果写入工作表。
第37~49行代码为递归过程用于查找下一级子成员。
第39行代码读取嵌套字典对象中保存的行数据。
第40行行指针标记递增，由于iR是模块级别变量，因此每次在GetChild中调用此变量时，仍保留原值，不会被初始化。
第41~43行代码将行数据写入结果数组中。
第44行代码判断字典中是否存在子成员的键，如果存在的话，说明该成员具备下一级子成员（即孙成员）。
第46行代码再次调用递归过程，注意此处的参数值，sChild作为第二个参数，即作为下一次调用的父成员。