Next Else
aRows = Split(Trim(dicData(sLob)(sState)(sNetwork))) For i = 0 To UBound(aRows) iCount = iCount + 1
aACPerTP(iCount) = aData(Val(aRows(i)), lCol) aFilteredRows(iCount) = Val(aRows(i)) Next End If
ReDim Preserve aACPerTP(1 To iCount), aFilteredRows(1 To iCount) '...
在上面的这个If...ElseIf...Else语句中，把代码分成了三段，分别对应于第一层起步的遍历到末层起步的遍历。代码中数组aACPerTP是用来记录本节开始提到的那列数据的，而aFilteredRows数组，顾名思义，就是用来记录筛选出来的记录的行号的（或是源数据数组的第一维数字）。很明显的，这段代码显得很啰嗦，在此文的后续部分我会介绍其它的方法来遍历树形结构。
对于CalAndFill过程的后续部分就不再介绍了，它执行了二次筛选，然后将需要的结果显示在了需要的地方。作为本节的结束，这里谈一下充分利用EXCEL名称定义的技巧。相信大家非常熟悉宏表函数，它利用的就是名称对象（Name），这个对象还可以用来命名一个Range对象，从而创建自己需要的索引。使用它的好处，除了让代码可读性更好以外（相信你很容易理解 If Range(\本月工资\去新马泰(\三日游\是啥意思，而很难看懂 If Range(\本月只能吃馒头 是为什么），另外一个好处是这个名称定义是随着被定义单元格的位置变化的，也就是说当调整了布局后，无需修改代码。另外，这个对象比较可气的是，当判断一个单元格或是Range是否有定义了名称时，我没找到什么好办法（可能没认真找过），不得不采用这样的代码： 复制内容到剪贴板 代码:
On Error Resume Next sName = Target.Name.Name On Error GoTo 0 If sName = ... Then ... End If
这里的第一个.Name是返回一个名称对象，第二个.Name则返回这个名称对象的名字。 <未完待续>
三之一、动态的树形数据结构的构建
本想起一个酷点的名字，实在是没啥创意，老老实实的写吧。这一节算是个过渡吧，会是结合一个例子来讲。
在前面第二节，我们已经建立了一个概念，即利用多层字典对象来构造一个树形的数据结构。在此后的两个案例中，需要注意一个现象，即这两个树形结构其层次的数量是固定的。但在现实活动中，我们经常会碰到这样的情况，即树形结构的层数不固定。在第二节中，我还介绍了如何用自定义数据类型的方法来构造树形结构，但对于如果层数不固定的情况，这种方法就无法应用了。而字典之所以强大，就是由于它构造数据结构的过程是使用代码实现的，这也就必然的使得它能够胜任动态构造的工作。
让我们结合一个例子来聊聊如何动态构造树形结构。这个例子是利用字典创建多层级联菜单（实际上是数据有效性提供的下拉选项，和菜单的概念一样），而菜单和层级内容则来自工作表记录的内容，也就说需要构造的多层字典的层数不固定。该例子在我的一个主题贴里：http://club.excelhome.net/thread-715907-1-1.html，由于是我自己的主题贴，我就不贴附件过来了，有兴趣的朋友点击 这里 下载。
实际上这个例子的代码非常短（相较于前面两个案例而言，我发现自己不光回帖写贴啰嗦，写代码也啰嗦），除去那个设置数据有效性的过程外，全部代码如下（当然不算Sheet1里的那些代码，那些是界面层面的内容，不属于我们目前讨论的范畴）： 复制内容到剪贴板 代码:
Public dMenuTitle '用来记录级联内容标题的字典（记录列号），简称标题字典 Public dMenuItems '用来记录级联内容的字典（多层），简称内容字典 Public Sub RenewMenuDic(ByVal ShtName$)
11
1: Dim arr, iColMax%, lRowMax&, i&, j&, sTitle$, dTemp 2: Set dMenuItems = Nothing: Set dMenuTitle = Nothing 3: Set dMenuItems = CreateObject(\4: Set dMenuTitle = CreateObject(\5: If Sheets(ShtName).[a1] = \由A1格开始定义 6: iColMax = Sheets(ShtName).[a1].End(xlToRight).Column 7: arr = Sheets(ShtName).[a1].Resize(1, iColMax)
8: For i = 1 To UBound(arr, 2): dMenuTitle(arr(1, i) & \9: lRowMax = Sheets(ShtName).[a1].End(xlDown).Row 10: If lRowMax = 1 Then Exit Sub
11: arr = Sheets(ShtName).[a2].Resize(lRowMax - 1, iColMax) 12: For i = 1 To UBound(arr) '循环项目数量 13: Set dTemp = dMenuItems '取得根字典
14: For j = 1 To iColMax - 1 '循环列数量-1，相对于字典层数 15: If Not dTemp.exists(arr(i, j)) Then
16: Set dTemp(arr(i, j)) = CreateObject(\如果是新的，添加新字典作为项目 17: End If
18: Set dTemp = dTemp(arr(i, j)) '取得下一层字典 19: Next
20: dTemp(arr(i, iColMax)) = \最后一层没东西的，只需要记录关键字就行 21: Next End Sub
这一节我们需要仔细分析下上面这段代码，所以我给每句语句都加上了行号，话说这就是当年Basic的样子，也是为什么会有GoTo 0 这样的语句的原因（因为总是从行号1开始的，呵呵），即便是现在微软仍然支持这样的写法的，真不错。
1~11行由于有前面的文章，这里就不多说了。嗯，第2行实际上是句废话，不知道当时怎么想的，先Set成Nothing，再重新建立字典对象。多说一句 CreateObject(\实际上和 New Scripting.Dictionary 是完全等价的，如果手动引用了 MicroSoft Scripting Runtime 的话。
这里要注意的是，从12句开始的这个循环循环体是菜单内容的记录即菜单内容的行，而由14句开始的循环则是循环了字典的层数。外部循环是为了读取菜单的每一行记录，而内循环则是根据这行记录，把末端节点放到对应的位置上去。或则我们可以这样来理解，每一行菜单记录，都描述了由树形结构的根节点到末端节点的路径。那么，这就需要用代码在外循环内，由根节点起遍历这个路径。所以，需要在外循环内部使用一个临时变量来获取根节点，然后在内循环利用这个临时变量，沿着路径，逐级向下的找到末端节点的位置。相信通过这样的一个利用树形结构的形象描述，上面这段代码就很容易理解了。
接下来为了要实现动态形成数据有效性，我使用了WorkSheet_Change事件，对于第一层（此处我们由根部向上层数变大）如果变化了，那么将对其下方和下一层两个格子设置有效性，而其余层则只设置其对应的下一层。全文代码如下： 复制内容到剪贴板 代码:
Private Sub Worksheet_Change(ByVal Target As Range) Dim dTitle, dTemp, i%, iCol%, arr, j%
If Target.Cells.Count > 1 Then Exit Sub '更改的单元格数量应该为 1 If Target.Row = 1 Then Exit Sub '第一行是标题
sTitle = Cells(1, Target.Column) '取得更改列的标题<该列标题>
If IsEmpty(dMenuTitle) Then RenewMenuDic Sheet2.Name '检查标题字典是否丢失 If Not dMenuTitle.exists(sTitle) Then Exit Sub '对照标题字典，确认是否在内 If dMenuTitle(sTitle) = dMenuTitle.Count Then Exit Sub '如果是最后一层，则退出
arr = [a1].Resize(1, [a1].End(xlToRight).Column) Set dTitle = CreateObject(\
12
For i = 1 To UBound(arr, 2): dTitle(arr(1, i)) = i: Next
'此上三行读取本表单的第一行作为标题，并用<本表标题字典>保存列号索引
arr = dMenuTitle.keys '获得标题字典的标题数组
Set dTemp = dMenuItems '获得内容字典，需要循环层数使用，故用临时变量 For i = 1 To dMenuTitle(sTitle) '循环到该列标题，以取得对应的内容字典的内容
If dTemp.exists(Cells(Target.Row, dTitle(arr(i - 1))).Value) Then '判断Target同行之前各列的数据是否在字典内 Set dTemp = dTemp(Cells(Target.Row, dTitle(arr(i - 1))).Value) '存在的话，取得下一层字典 Else
'不存在的话，删除其后同行的各格的数据有效性定义 Application.EnableEvents = False For j = i To dMenuTitle.Count - 1 With Cells(Target.Row, dTitle(arr(j))) .Validation.Delete .ClearContents .Interior.ColorIndex = 0 End With Next
If i = 1 Then '如果Target是第一级，则删除下一行第一级格子的数据有效性定义 With Target.Offset(1, 0) .Validation.Delete .ClearContents .Interior.ColorIndex = 0 End With End If
Application.EnableEvents = True Exit Sub End If Next
'设置Target同行下一格的数据有效性为对应层字典的关键字数组形成的字符串 SetValidation Me.Name, Target.Row, dTitle(arr(dMenuTitle(sTitle))), Join(dTemp.keys, \ If dMenuTitle(sTitle) = 1 Then
'如果Target是第一级，则同时设置下一行第一级
SetValidation Me.Name, Target.Row + 1, Target.Column, Join(dMenuItems.keys, \ End If
Set dTitle = Nothing End Sub
由于这段代码有足够的注释，我就不再展开说了。嗯，在原贴里有朋友提到菜单表内如果数据不全会产生错误，其实这很容易把容错代码加进来，以判断某个路径是否到达末端节点。比如，在构造树形结构数据的时候，可以加一个判断，如果某层下一级为空，则该层不再创建字典，并赋值成一个空字符串，退出内循环。然后在沿路径向下时，对于途经节点，利用函数IsObject增加一个判断，这样如果该节点的Item项是对象则说明不是末端节点，否则就到达末端节点退出循环。有兴趣的朋友可以按这个思路自己动手改改代码，改完后，这段代码就可以动态的形成一个分支长度（即某分支的层数）不确定，字典总层数可随数据变化的树形结构了。
在本节的例子中，我们讲了如何利用字典对象动态的构建树形结构和沿一确定途径到达末端节点的方法。 <未完待续>
三之二、动态树形结构的遍历
前文我们了解了如何动态的构建树形结构，并且也掌握了如何沿一已知路径到达末端节点。然而在现实世界中，我们经常会碰到需要遍历某节点下所有节点的需要。比如我们需要取得某一目录下所有文件（包括其下子目录），实际上Windows的文件结构是
13
个非常好的树形结构例子。如果参考一下前面二之二节的那个案例，我们会发现在遍历这样的树形结构时，我们碰到了一个问题，那就是层的数量未知，而且层数可能会非常大。这样一来，势必不能通过简单的循环嵌套的办法来实现，最为简便的办法就是递归，有关递归的帖子EH里也有不少，这里推荐两个：一个是彭版的递归（基础教程），另一个是qee大拿的归去来兮－－漫谈递归
本节还是会结合一个案例来讲，这个例子是之前二之二节中那个帖子里最后的成品。由于这篇文章是一时心血来潮的东西，所以是写一点发一点，导致没能开始就占好楼层，让大家翻帖麻烦了。那个帖子的地址是：
http://club.excelhome.net/viewthread.php?tid=720328 ，最终的成品在该帖第5页的41楼，我把这个附件放在了此帖里，方便大家下载。
言归正传，由于我一开始没有料到该帖楼主会要求更改级联菜单的数量，所以在构造多层字典的时候是逐级向下写代码的，而在后续处理数据后的遍历读取时，又采用了嵌套循环的办法。这样子一来，再增加级联层数就会导致几乎所有的代码都需要改动，而且随着层数的增加，其后续的遍历就会越来越麻烦。于是我引入了动态构建树形结构的办法，下面我们来逐段分析这个例子里的ParseData。 复制内容到剪贴板 代码:
'定义级联层数
Set dicLayers = CreateObject(\ dicLayers(PR_NAME_LOB) = PR_TITLE_LOB dicLayers(PR_NAME_STATE) = PR_TITLE_STATE
dicLayers(PR_NAME_NETWORK) = PR_TITLE_NETWORK dicLayers(PR_NAME_RANK) = PR_TITLE_RANK
aLayers = dicLayers.items
我设立了一个全局变量dicLayers用来保存菜单的层数，由于考虑到后续处理数据时是由菜单项来确定层数的，所以我使用的是一个字典对象而不是简单的数组，这个字典对象用菜单项（即预定义的单元格名称）索引了对应的字典层数（即列标题，由于有列标题索引列号的字典，所以这里是等价的）。对比二之二节的代码，可以发现代表层数的列数量现在多了一个，即Rank列。然后，用aLayers这个数组保存字典层数对应的列标题。
让我们省略掉中间的几行相同代码，看看后面构造树形结构的部分： 复制内容到剪贴板 代码:
For i = 1 To UBound(aData, 1) Set dTemp = dicData For j = 0 To UBound(aLayers)
If Not dTemp.exists(aData(i, dicTitle(aLayers(j)))) Then _
Set dTemp(aData(i, dicTitle(aLayers(j)))) = CreateObject(\ Set dTemp = dTemp(aData(i, dicTitle(aLayers(j)))) Next
dTemp(i) = aData(i, dicTitle(PR_TITLE_ACPERTP))
Set dTemp = dicData(PR_LOB_ALL) For j = 1 To UBound(aLayers)
If Not dTemp.exists(aData(i, dicTitle(aLayers(j)))) Then _
Set dTemp(aData(i, dicTitle(aLayers(j)))) = CreateObject(\ Set dTemp = dTemp(aData(i, dicTitle(aLayers(j)))) Next
dTemp(i) = aData(i, dicTitle(PR_TITLE_ACPERTP)) Next
与前面那个动态构建树形结构的代码一样，这里也是同样的两级循环嵌套，外层是数据的行，内层则是级联层数，而那个并列的内循环则是为了构造LOB的All项，与二之二节是一样的。希望你没有被那个括号套括号的引用方法搞晕，我们来从内向外逐个看一下好了，其实是很清晰的：aLayers(j) 是第 j 层字典对应的列的标题，而 dicTitle(aLayers(j)) 则是该列对应的列号，aData(i,
14
dicTigle(aLayers(j))) 则是该列的第 i 行数据。使用这样的构造方法，级联层数的先后顺序就会是由前面定义赋值dicLayers时的先后顺序决定的，因为我们知道字典的Keys和Items这两个方法返回的数据顺序就是由 关键字 第一次 赋值 的顺序 。
接下来的问题就是如何遍历了，如本节开始所述，我采用了递归的办法来实现从任何一个节点起步遍历其下所有节点直至末端。 来看一下代码吧，下面是修改后的CalAndFill过程的开始部分： 复制内容到剪贴板 代码:
Private Sub CalAndFill(aLayers, iLayer%) '(sLob$, sState$, sNetwork$)
Dim sinMin!, sinMax!, sinMean!, sinDev!, sinUCL!, i&, j&, k&, iCount&, lCol
Dim aACPerTP, dTemp, aStateKeys, aNetworkKeys, aRows, aFilteredRows, aOutput, aTitles Dim dLayerNow, sinUCLPer!
If Not dicData.exists(aLayers(0)) Then Exit Sub
Set dLayerNow = dicData For i = 0 To iLayer
Set dLayerNow = dLayerNow(aLayers(i)) Next
ReDim aACPerTP(1 To UBound(aData)), aFilteredRows(1 To UBound(aData)) iCount = 0
GetDataFromDic iCount, aACPerTP, aFilteredRows, dLayerNow ReDim Preserve aACPerTP(1 To iCount), aFilteredRows(1 To iCount)
首先是参数的变化，原先我们将三个菜单项的选择结果都传递给了这个过程，以便确定起步节点的位置。但现在由于我们要实现动态的或是级联层数容易调整的功能，原本静态的传递全部已知节点信息的方法就不可行了。所以我将初始节点信息按顺序做成了数组aLayers进行传递，这是因为菜单的选择是交互式一步一步进行的，势必使得我们能够掌握初始节点的信息（即由根至该节点的路径）。而iLayer参数是该节点的层数，之所以加这么一个参数仅仅是为了让代码写起来简单一些。
接下来获得初始节点的 4 行语句和上一节是一样的，这是一个由树形结构根部经已知路径到达某个节点的过程。下面就是遍历该初始节点其下各末端节点数据并建立筛选结果行号数组的过程，可能你会惊讶的发现原本在二之二节中啰嗦的If ElseIf... 及其中的循环嵌套不见了，仅仅是简单的一个过程调用，就一句！这就是递归的魅力，呵呵。在我们看这个递归过程的代码之前，先看看我们给它传递了哪些参数吧：iCount，这个是记录筛选结果的数量的，因为我们先是定义数组元素数量等同全部数量，筛选完以后再Redim的，所以需要这样的一个变量来记录数量；aACPerTP，这个数组是为后续计算用的；aFilteredRows，这个数组是用来存放筛选结果的行号的；dLayerNow，起始节点的字典对象。下面是这个子过程的全文代码： 复制内容到剪贴板 代码:
Private Sub GetDataFromDic(iCount&, aACPerTP, aFilteredRows, ByVal FromDic) Dim i&, aKeys, dTemp aKeys = FromDic.keys
If IsObject(FromDic(aKeys(0))) Then For i = 0 To FromDic.Count - 1
GetDataFromDic iCount, aACPerTP, aFilteredRows, FromDic(aKeys(i)) Next Else
For i = 0 To FromDic.Count - 1 iCount = iCount + 1
aFilteredRows(iCount) = aKeys(i) aACPerTP(iCount) = FromDic(aKeys(i)) Next End If
15
