VBA编程技巧 之 字典对象使用经验谈

VBA编程技巧 之 字典对象使用经验谈（更新至四之一） 字典对象使用经验谈 目录

前言_______________________________________01 楼 一、字典的基本功能___________________________01 楼 二、The Hardcore of Dictionary__________________02 楼 二之一、多层字典对象应用案例分析 1 _____________16 楼 二之二、多层字典对象应用案例分析 2 _____________30 楼 三之一、动态的树形数据结构的构建________________35 楼 三之二、动态树形结构的遍历____________________54 楼 三之三、送你把漂亮的解牛小刀___________________64 楼 三之四、上帝的归上帝，凯撒的归凯撒______________66 楼 四之一、利用字典动态的构建自定义数据类型___________68 楼 前言

相信大家对字典对象已经是耳熟能详了。现在帮人写个代码如果不来个字典，出门都不好意思和人打招呼。EH里也有大量的帖子详尽的介绍了字典对象的功能和各种使用方法，我大致翻过这些帖子，感觉很有必要和大家交流一下最近一段时间泡坛子、帮人家写代码得到的一些心得体会。可能更多的会聊一些编程思路的东西，所以我想这篇文章应该是给有一定基础的朋友看的，起码应该能不需要注释就能看懂代码，起码应该看过置顶贴里提到的那些帖子。 一、字典的基本功能

相信字典对象最为出名的是它的关键字不重复特性，我们经常会看到这样的语句： For i=0 to UBound(arr) dic(arr(i,1))=\Next

这段语句唯一的作用就是将数组的第一列数据去掉了重复项。但值得强调的是既然我们叫它字典对象，那么它就理所应当的具有翻译功能。

以一个典型的EXCEL数据表为例，很多情况下会是类似于一个数据库中 表 这样的一个结构，即具有第一行的表头部分定义了每一列的内容是什么，其下每一行都是一条单独的纪录。那么这种情况下，我们完全可以用字典对象来创建由表头来翻译索引列号。这至少带来两个好处，1、使得你的代码更具有可看性，或则说更像自然语言；2、使得你的代码不会依赖于表格的地理位置，也就是说即便出于某种原因列的顺序有了变动，你也不需要去找出你的代码里涉及到相应列号并逐一改正。其实，更重要的一点，是你的代码会具有更大的适用性。

让我们来比较两段代码，设想我们需要读取一个月工资表并统计各班组的绩效奖金，其包含 姓名、班组、工位、基本工资、绩效奖金等等信息，那么可能的代码会是这样的： 复制内容到剪贴板 代码:

Dim dic, arr, i&, lRow&

lRow = Sheet1.[a65536].End(xlUp).Row arr = Sheet1.Range(\

Set dic = CreateObject(\For i = 1 To UBound(arr)

dic(arr(i, 2)) = dic(arr(i, 2)) + dic(arr(i, 5)) Next

'================= Dim dTitle, arr, i&, dic arr = Sheet1.[a1].CurrentRegion

Set dTitle = CreateObject(\For i = 1 To UBound(arr, 2) dTitle(arr(1, i)) = i Next

1

Set dic = CreateObject(\For i = 2 To UBound(arr)

dic(arr(i, dTitle(\班组\班组\绩效奖金\Next

第二段代码我们使用了一个名为dTitle的字典对象来记录表头名称和对应列号，这样当我们需要使用某列数据的时候，我们可以使用这个对象来将表头名翻译成列号。很明显的是第一段代码完全依赖于表格内容的地理位置，而且如果不去看数据表的话，你根本不知道它在干什么。而相应的，对于第二段代码而言，我们完全可以不用去了解数据表是什么样的，只需要知道它有这样的两个表头就可以了。并且你不觉得它很接近自然语言了吗？哦，不吗，你确定？那我再稍微改一下： 复制内容到剪贴板 代码:

数据 = Sheet1.[a1].CurrentRegion

Set 表头之列号 = CreateObject(\For i = 1 To UBound(数据, 2) 表头之列号(数据(1, i)) = i Next

Set 班组绩效奖金 = CreateObject(\For i = 2 To UBound(数据)

班组名 = 数据(i, 表头之列号(\班组\

成员绩效奖金 = 数据(i, 表头之列号(\绩效奖金\

班组绩效奖金(班组名) = 班组绩效奖金(班组名) + 成员绩效奖金 Next

如果出于某些原因，原来的那个工资表在绩效奖金之前增加了一列，比如说老板大发善心为大家增发了住房津贴，显然作为劳资统计的你不会希望把它给漏了。那么这时，如果你的代码是前面第一种方法，那么你必须仔细检查你的代码，确保每一个数字对应的列是你需要的内容。但是如果你非常幸运的看过了这篇文章，并且使用了第二种方法，恭喜你，你不用像前者那样心惊胆颤的一个个数列数了，开开心心的在一边数钱吧！

可能有看官说了：嘿，我们老板才烦呢，他不会加发工资的，他会把那个绩效奖金的名字改成工作表现奖！你瞧，这下你要去改代码了吧。那么这里我想说的是，养成良好的编程习惯，使用常量设置。如果你经常写代码的话，你肯定会碰到前面这位看官提到的情况，那么你就会知道使用常量设置是多么方便的事情。千万不要为了少敲键盘而省略这个过程，我们要牢记我军的优良训练传统：训练多流汗，战时少流血！编写多常量，更改不挠头！

想想还是把代码写出来看看效果吧： 复制内容到剪贴板 代码:

Public Const PR_SALARY_GROUP = \班组\Public Const PR_SALARY_BONUS = \绩效奖金\....

Dim dTitle, arr, i&, dic arr = Sheet1.[a1].CurrentRegion

Set dTitle = CreateObject(\For i = 1 To UBound(arr, 2) dTitle(arr(1, i)) = i Next

Set dic = CreateObject(\For i = 2 To UBound(arr)

dic(arr(i, dTitle(PR_SALARY_GROUP))) = _

dic(arr(i, dTitle(PR_SALARY_GROUP))) + arr(i, dTitle(PR_SALARY_BONUS)) Next <未完待续>

二、The Hardcore of Dictionary

2

琢磨了半天，还真没想出什么中文词来表达Hardcore比较合适。（题外话，不建议去Google搜索这个关键字，但相信我这个词本身没有任何相关的含义，真的是个好词。）

我们知道字典对象由关键字 Key 和数据项 Item 构成。通常情况下 Key 是字符串，实际上也可以是其它数据类型，比如整数、小数等。而数据项则可以是任何数据类型，包括字典对象本身。这样我们就可以创建多层的字典对象了。利用多层字典对象，我们可以实现诸如级联菜单、联动数据有效性序列、联动下拉框等等应用，这也常见于坛子里各个帖子。这里我不想重复谈这些应用，而是想着重强调其背后隐藏的一个概念。

我们到底用字典作了什么？一言以蔽之，所谓的多层字典，实际上你利用它构造了一个树型数据结构！

坛子里也有很多帖子在介绍TreeView这个控件，它和我们的多层字典何其相似。让我们还是以上面那个工资表来作为例子，我们可能希望把它处理成这样的一个形式： 复制内容到剪贴板 代码:

Public Const PR_SALARY_GROUP = \班组\Public Const PR_SALARY_POSITION = \工位\Public Const PR_SALARY_NAME = \姓名\Public Const PR_SALARY_BASE = \基本工资\Public Const PR_SALARY_BONUS = \绩效奖金\

Public Function ParseData() Dim dTitle, arr, i&, dic, dTemp arr = Sheet1.[a1].CurrentRegion

Set dTitle = CreateObject(\ For i = 1 To UBound(arr, 2) dTitle(arr(1, i)) = i Next

Set dic = CreateObject(\ For i = 2 To UBound(arr)

If Not dic.Exists(arr(i, dTitle(PR_SALARY_GROUP))) Then _

Set dic(arr(i, dTitle(PR_SALARY_GROUP))) = CreateObject(\ Set dTemp = dic(arr(i, dTitle(PR_SALARY_GROUP)))

If Not dTemp.Exists(arr(i, dTitle(PR_SALARY_POSITION))) Then _

Set dTemp(arr(i, dTitle(PR_SALARY_POSITION))) = CreateObject(\ Set dTemp = dTemp(arr(i, dTitle(PR_SALARY_POSITION))) If Not dTemp.Exists(arr(i, dTitle(PR_SALARY_NAME))) Then _

Set dTemp(arr(i, dTitle(PR_SALARY_NAME))) = CreateObject(\ Set dTemp = dTemp(arr(i, dTitle(PR_SALARY_NAME))) dTemp(PR_SALARY_BASE) = arr(i, dTitle(PR_SALARY_BASE)) dTemp(PR_SALARY_BONUS) = arr(i, dTitle(PR_SALARY_BONUS)) Next

Set ParseData = dic Set dTitle = Nothing End Function

如果我们使用类似这样的语句 Set dicSalary = ParseData() 调用上面这个程序，那么我们可能得到的一个数据结构，会是如下这样子的：

复制内容到剪贴板 代码: dicSalary ├─甲班 │ ├─拼装

3

│ │ ├─张三

│ │ │ ├─基本工资 -> $1000 │ │ │ │

│ │ │ └─绩效奖金 -> $800 │ │ │ │ │ └─李四

│ │ ├─基本工资 -> $1000 │ │ │

│ │ └─绩效奖金 -> $800 │ │ │ └─焊接 │ ├─王二麻子

│ │ ├─基本工资 -> $1100 │ │ │

│ │ └─绩效奖金 -> $900 │ │ │ └─赵大

│ ├─基本工资 -> $1100 │ │

│ └─绩效奖金 -> $900 │ └─乙班 ├─拼装 │ ├─诸葛

│ │ ├─基本工资 -> $1000 │ │ │

│ │ └─绩效奖金 -> $800 │ │ │ └─南宫

│ ├─基本工资 -> $1000 │ │

│ └─绩效奖金 -> $800 │ └─焊接 ├─西门

│ ├─基本工资 -> $1100 │ │

│ └─绩效奖金 -> $900 │ └─轩辕

├─基本工资 -> $1100 │

└─绩效奖金 -> $900

那么，对于这样一个数据结构，我们调用张三的基本工资就会是这样子的： 张三的基本工资 = dicSalary(\甲班\拼装\张三\基本工资\

当然，我们也可以使用自定义类型来实现这一目的，代码可能会是象下面这个样子： 复制内容到剪贴板 代码:

4

Public Type Salary Name As String Amount As Single End Type

Public Type Person Name As String Salaries() As Salary End Type

Public Type Position Name As String Persons() As Person End Type Public Type Group Name As String Positions() As Position End Type

这里，我不想再去写赋值代码，因为那实在是一个非常繁琐的过程。不过我们可以想象一下这个赋值的过程，我们需要重新定义每层的数组元素数量，可能还需要通过循环来定位是数组的第几个元素。而反过来当我们需要调用某个值得时候，也同样的啰嗦。这时我们可以非常明显的看到使用字典对象的方便了，因为字典对象让我们可以用关键字来进行索引，而不需要对整个元素集合进行顺序遍历来查找定位。

提到集合，实际上我们还可以使用VBA原生的一个对象，就是集合对象（Collection），来实现这一目的。但这里存在一个问题，集合对象没有 Exists 方法，也就是说你无法知晓某个关键字是否存在，只能通过 On Error Resume Next，引用此关键字，再去判断 Err.Number > 0 来得到答案，同时还要再清除这个错误，会麻烦不少。不过这里不得不提一下集合对象的一个优势，那就是在它的Add方法支持 After/Before 参数，使得在初始赋值时，非常适合同时进行排序工作，如果你需要对你的树结构进行排序的话，建议你考虑用Collection对象。

看到这，相信你已经完全了解了字典对象在构造树形结构方面的优势。有必要在这里解释一下，为什么这种数据结构非常重要。通过上面的树形图，想必很容易理解这种结构清晰的反映了数据间的归属关系或是上下级关系。而在现实生活中，我们几乎可以用这种结构来描述各种事物，公司的人员结构、文档的归类整理、你家的门牌号，等等等等。这也是为什么我们在EH的VBA版看到大量的字典对象应用的根本原因，因为它太适合用来处理最常见的各种数据了。 接下来，我会结合具体的案例，来聊聊字典是如何处理树形结构数据的。 <未完待续>

二之一、多层字典对象应用案例分析 1

这里我们以一个跟据已有标签内容数据、创建格式化标签供打印用的实际案例，来聊聊使用多层字典对象构造树形数据结构如何解决问题的。

这个例子的帖子地址：http://club.excelhome.net/viewthread.php?tid=720876 为避免由于楼主编辑帖子，我把他的原始附件和最后我帮他完成的附件都贴在这里。有兴趣的同学也可以去这个贴子看看，我在11楼提到的楼主代码的问题其实就是一些经验之谈。看看楼主原来的附件里的代码，你会发现他是在用Select Case语句完成字典的翻译功能，这样的做法违背了一个编程的基本原则，混淆了代码和数据的区别。正如我在该贴11楼提到的，他的SN（Serial Number）和Mask（某种规格）、Tray Type（托盘型号）之间存在着多对一的关系，即SN确定则后两者都是确定的。这种情况下，这样关系太适合用字典来描述了，同时这种关系本身是数据的，那么理应让它成为数据，所以我才要求楼主准备这样一个对照表。可能有朋友会发现我比较啰嗦，但实际情况说明作为一个在EH的VBA版帮人写代码的家伙，适当的和楼主交流是多么的必要。这就和你作为一个销售人员，在商业谈判中穿插着聊一些有趣的话题同时进一步了解客户需求的道理是一样的，即增进了感情又能掌握更多的信息，避免走弯路，呵呵。 还是回到这个小节的主题上来，我们先来分析一下这个例子里的数据是什么样的一个结构。 1、标签的数据有了，而且是按通常的数据库结构建立的，即表头、记录 2、标签的结构有两种，是按托盘型号区分的

3、标签是按包打印的，即每包一个标签，而同一包的芯片对应的Mask和Chip这两个值都是一样的 4、每包内又有数个托盘，每个托盘有数个芯片即序列号

看到这里，相信你也同样的发现这就是一个典型的树形结构，它的数据归属关系应该是这样子的：托盘型号 -> 包号 -> 托盘

5

号 -> 芯片。为此，我写了这样的一个过程来构造这个标签数据结构，如下： 复制内容到剪贴板 代码:

Private Function ParseData()

Dim aData, lRow&, i&, dic, dTemp

lRow = Cells(65536, MPL_COL_SN).End(xlUp).Row

aData = Cells(MPL_START_ROW, 1).Resize(lRow - MPL_START_ROW + 1, 7)

Set dic = CreateObject(\ For i = 1 To UBound(aData)

If Not dic.exists(aData(i, MPL_COL_TYPE)) Then _

Set dic(aData(i, MPL_COL_TYPE)) = CreateObject(\ Set dTemp = dic(aData(i, MPL_COL_TYPE))

If Not dTemp.exists(aData(i, MPL_COL_PACK)) Then _

Set dTemp(aData(i, MPL_COL_PACK)) = CreateObject(\ Set dTemp = dTemp(aData(i, MPL_COL_PACK)) dTemp(\ dTemp(\ If Not dTemp.exists(aData(i, MPL_COL_TRAY)) Then _

Set dTemp(aData(i, MPL_COL_TRAY)) = CreateObject(\ Set dTemp = dTemp(aData(i, MPL_COL_TRAY)) dTemp(aData(i, MPL_COL_SN)) = True Next

Set ParseData = dic End Function

为了更加直观的表达这段代码，让我们来给它画个树形图 复制内容到剪贴板 代码: dic (变量名) │

└─托盘型号 │ └─包号 │

├─CHIP -> CHIP 值 │

├─MASK -> MASK 值 │ └─托盘号 │

└─序列号

话说我们在处理EXCEL数据时，绝大多数的情况都可以分为三个步骤，即 读取整理数据、计算构造输出数据、输出结果，前者和后者会和EXCEL工作表交互，而中间的那个步骤则是在内存中完成的。我们知道数据结构决定了算法，也就是说第一步的读取整理数据决定了中间的计算和后面的输出的代码难易度。上面这段代码的作用就是把原始的数据记录构造成了上图示意的一个树形数据结构，这也是为什么我把这段程序命名为ParseData而不是ReadData的原因。说起来这个问题，如果你碰到要编程序处理数据了，一时想不好该干些什么，我告诉你可以先写象这样的几行代码，肯定没错的： 复制内容到剪贴板

6

代码:

Public Sub 我要炒股票挣钱()

Call 读取分析股票数据 ' ParseData Call 计算哪个股票挣钱 ' CalData Call 告诉我是哪个股票 ' OutputResult End Sub

是不是看上去很简单啊，事实上就是这么简单的。我们接着来看看此例中，CreateLabels是怎么工作的，它的代码如下： 复制内容到剪贴板 代码:

Public Sub CreateLabels()

Dim dic, aTrayTypes, i%, j%, dTemp, aPacks, dtPack As Date dtPack = Range(MPL_NAME_DATE) Set dic = ParseData aTrayTypes = dic.keys

For i = 0 To UBound(aTrayTypes) ClearLabel aTrayTypes(i) Set dTemp = dic(aTrayTypes(i))

CopyBlankLabel aTrayTypes(i), dTemp.Count aPacks = dTemp.keys If aTrayTypes(i) = 1 Then For j = 0 To UBound(aPacks)

FillLabelOne j + 1, aPacks(j), dTemp(aPacks(j)), dtPack Next

ElseIf aTrayTypes(i) = 2 Then For j = 0 To UBound(aPacks)

FillLabelTwo j + 1, aPacks(j), dTemp(aPacks(j)), dtPack Next End If Next

Set dic = Nothing End Sub

你瞧，整个过程如果用语言来描述的话，就像这样：1、读取分析数据；2、清空标签模版内容；3、按需要复制空白标签模版；4、逐个填写标签内容。如果你有一定的英文基础的话，上面这段代码你甚至不需要任何注释就能轻易看明白，难道不是吗？这里我想说一下另外一个良好的编程习惯：遵循一定的变量命名规则。每个人都会有自己的命名习惯，但我想说的是让这种习惯遵循一定的规则，并尽可能的让它表达自身的含义。我注意到坛子里很多高手都喜欢用单字符、双字符命名变量，他们自己完全搞得清楚，那是因为他们是高手而且是自己写的不长的代码。但我真的很想告诉你，那其实是一个非常非常坏的习惯，甚至都不需要长时间以后再去理解代码，仅仅是需要写一个长点的代码，就会让你感觉云山雾罩了，而不得不写很多的注释来告诉自己这段是干嘛的那段是干嘛的。

另外一个技巧就是把你的代码中相对独立的片断，拎出来单独写个过程或是函数，其好处不仅仅是避免重复的代码，更大的好处是让你可以更为专注的解决一个相对独立的功能而不用去考虑全局的情况，给这个过程起一个恰当的名字，同样会让你的代码更容易看懂，让你的代码会说话。有兴趣的朋友可下载此节开头提到的帖子里4楼的附件，那是一开始我为楼主写的代码，因为最初楼主只是提到了一种标签，估计他的想法是学习一下实现方法然后自己作的，呵呵。

还是回到主题，我们已经构造了合适的数据结构，已经准备好了空白的标签，接下来要做的无非就是把相应的数据填进去就行了。以第一种标签为例，填写一个空白标签的代码如下： 复制内容到剪贴板 代码:

Private Sub FillLabelOne(iLabelNo, iPackNo, dicPack, dtPack As Date) Dim iRow%, iCol%, i%, j%, aTrays, aHead, aCont, iChipNum%, dTray, aSNs

7

ReDim aHead(1 To MPL_LB_ONE_HEAD_ROW, 1 To MPL_LB_ONE_COL) ReDim aCont(1 To MPL_LB_ONE_CONT_ROW, 1 To MPL_LB_ONE_CONT_COL) aTrays = dicPack.keys iChipNum = 0 For i = 1 To 5 aCont(i + 1, 1) = i Next

If UBound(aTrays) > 5 Then For i = 1 To 5 aCont(i + 7, 1) = i Next End If

For i = 2 To UBound(aTrays) Set dTray = dicPack(aTrays(i))

aCont(((aTrays(i) - 1) \\ 3) * 6 + 1, ((aTrays(i) - 1) Mod 3) * 5 + 2) = aTrays(i) aSNs = dTray.keys For j = 0 To UBound(aSNs)

aCont(((aTrays(i) - 1) \\ 3) * 6 + j + 2, ((aTrays(i) - 1) Mod 3) * 5 + 2) = aSNs(j) iChipNum = iChipNum + 1 Next Next

aHead(1, 1) = iPackNo aHead(2, 1) = dicPack(\ aHead(2, 10) = dicPack(\ aHead(3, 1) = iChipNum aHead(4, 1) = dtPack

With Sheets(MPL_SHT_NM_LABEL_ONE)

iRow = ((iLabelNo - 1) \\ 2) * (MPL_LB_ONE_ROW + 1) + 1 iCol = ((iLabelNo - 1) Mod 2) * (MPL_LB_ONE_COL + 1) + 1

.Cells(iRow, iCol).Resize(MPL_LB_ONE_HEAD_ROW, MPL_LB_ONE_COL) = aHead iRow = iRow + MPL_LB_ONE_HEAD_ROW

.Cells(iRow, iCol).Resize(MPL_LB_ONE_CONT_ROW, MPL_LB_ONE_CONT_COL) = aCont End With End Sub

这段代码的作用就是填写一个空白标签，结合前面说到的专注的问题，如果我们把这段代码放回到CreateLabels里并不是做不到，但你会发现那样一来，你的代码就会变得很啰嗦。你需要定位填写的标签，并且需要把这些定位反映到代码里。而如果分离出来，通过参数把需要的信息传递过来，那么你仅仅需要考虑填写一个标签的问题就可以了。

这段代码是将标签分为两部分填写的，头部和下方的详细内容。实际上，几乎任何一个描述类似事情的表格都可以这样来区分，诸如 报关单、工资表、发货清单、加工清单等等，你都可以采用同样的办法，使用字典对象建立一个树形结构，整理成你希望的形式并输出。这里使用的是一个Variant型的数组输出到工作表的，因为标签模版的形式是希望没有数据的地方留为空白，而Variant型数组正好可以实现这一要求，对于没有赋值的数组元素在输出到工作表时，对应的单元格是不填任何东西的。具体到内部的计算，无非就是按照模版的结构，对相应的数组元素赋值的过程，这里就不详细讲了。

此节附件里，还有两个字典对象的应用，一个是根据输入的SN信息，结合包装的特性，生成分包清单；另一个是在输入SN过程中，利用一个全局变量字典对象，检查是否已经存在该SN，以避免重复。有兴趣的朋友可以参考一下。 <未完待续>

二之二、多层字典对象应用案例分析 2

接下来这个例子是一家保险公司的数据，希望从已有的数据中根据不同的客户类别、地理位置和是否在销售网络中的属性这三个不同层级，来筛选数据，动态的将筛选结果显示在一个工作表内。帖子的地址是：

8

http://club.excelhome.net/viewthread.php?tid=720328 。这个帖子偏长，除了因为楼主后来又增加了要求以外，更大的原因是由于我写代码不仔细，错误的将一个循环变量 i 写成了常数 0 。而这个错误又是非常的不明显，以至于浪费了好几个楼层来讨论如何获得必要的调试信息。我们在这里先看看一个中间品，稍后我们再把最终的成品分析一下，作为对比。可能的话，我还会针对这个案例，再改进一下。另外，有兴趣的朋友也可以看看该贴中，我的头一个附件，在3楼，前后比较一下代码是如何根据需要的不同而演化的。这个中间品的楼层在该贴的第2页的13楼，其后应楼主的要求，我还指导过如何自行调整代码，此帖附件是调整后的代码。

与前一个案例一样，我们还是先结合需要分析一下现有的数据。如前所述，我们需要根据需要动态筛选数据，这一过程其实也可以手动完成的，筛选条件如下：1、客户类别 LOB（没猜错的话是 Label Of Business）；2、地理位置，即州别，Phy State（没猜错的话 是 Physician State）；3、是否在网络中，In Network（估计指的是销售网络），对于筛选出来的记录，我们需要对其中一列数据（Allowed Costs/Treated Patients，猜测是指每个治愈患者的允许费用）计算一些诸如最大最小值、平均值、方差等，然后需要进一步根据计算结果，将该列数据中大于某种平均值的记录筛选出来，并进一步计算平均值和列出筛选结果。楼主在需要显示结果的表Summary内，已经规划好了显示位置，以及用户交互方式，及使用单元格数据有效性提供的下拉框，形成菜单式选项。

很明显的第一步筛选过程，其实也是一个树形结构，也就是说完全可以使用多层字典对象来实现，有了前面的基础，这里我就不画树形图了，层级关系就上面的1、2、3的顺序。那么ParseData过程的代码就是下面这个样子的： 复制内容到剪贴板 代码:

Private Sub ParseData()

Dim i&, lRowMax&, lColMax&, dTemp, aTitle

lRowMax = Sheets(PR_DATA_SHT_NM).[a1].End(xlDown).Row lColMax = Sheets(PR_DATA_SHT_NM).[a1].End(xlToRight).Column aTitle = Sheets(PR_DATA_SHT_NM).[a1].Resize(1, lColMax)

aData = Sheets(PR_DATA_SHT_NM).[a2].Resize(lRowMax - 1, lColMax)

Set dicData = CreateObject(\ Set dicTitle = CreateObject(\

For i = 1 To UBound(aTitle, 2) dicTitle(aTitle(1, i)) = i Next

Set dicData(PR_LOB_ALL) = CreateObject(\

For i = 1 To UBound(aData, 1)

If Not dicData.exists(aData(i, dicTitle(PR_TITLE_LOB))) Then _

Set dicData(aData(i, dicTitle(PR_TITLE_LOB))) = CreateObject(\ Set dTemp = dicData(aData(i, dicTitle(PR_TITLE_LOB)))

If Not dTemp.exists(aData(i, dicTitle(PR_TITLE_STATE))) Then _

Set dTemp(aData(i, dicTitle(PR_TITLE_STATE))) = CreateObject(\ Set dTemp = dTemp(aData(i, dicTitle(PR_TITLE_STATE)))

dTemp(aData(i, dicTitle(PR_TITLE_NETWORK))) = dTemp(aData(i, dicTitle(PR_TITLE_NETWORK))) & i & \

Set dTemp = dicData(PR_LOB_ALL)

If Not dTemp.exists(aData(i, dicTitle(PR_TITLE_STATE))) Then _

Set dTemp(aData(i, dicTitle(PR_TITLE_STATE))) = CreateObject(\ Set dTemp = dTemp(aData(i, dicTitle(PR_TITLE_STATE)))

dTemp(aData(i, dicTitle(PR_TITLE_NETWORK))) = dTemp(aData(i, dicTitle(PR_TITLE_NETWORK))) & i & \

9

Next End Sub

有了前文介绍的使用表头索引行号的概念、常量的概念、构造树形数据结构的概念，相信读懂这段代码应该不难。这里有三点需要说明一下，1、楼主对于LOB项有个要求，除了表内现有内容外，增加了一个All选项用来显示全部客户类别的信息，所以我们在代码内，定义了一个PR_LOB_ALL这个常量索引，并使它和其它LOB项内容同级；2、由于还要对筛选结果进行二次筛选，而且还要列出源数据表中其它列的内容，所以这里在树形结构的末端，我们采用了字符串的方式来索引每个分支对应的行号，行号之间是由空格分开的，由于最后会多出一个空格，所以在后面引用它的时候，要使用Trim函数把它去掉，然后用Join函数把这个字符串变成数组；3、由于要动态的显示筛选结果，所以我将 标题字典（dicTitle）、树形结构字典（dicData）、数据数组（aData）这三者都设置成了全局变量，也就是说在内存里制作了一个源数据表的副本，并且根据我们的需要，使用字典对象对它进行了索引。这其实是一个典型利用内存空间换取执行速度的方法，要知道对于内存中驻留的数据进行计算的操作要比从任何形式的其它位置读一次数据要快的多，也就事实上使得人们在交互时产生结果实时动态显示的感觉。

好了，我们已经构造好了我们的树形结构，并且对数据数组进行了索引，那么接下来要做的工作就是根据筛选条件，进行筛选和计算。如果大家有去看那个帖子的话，会发现我提出让代码可以在每一次选择菜单的时候，都会动态显示结果，而不是非要选择到末端菜单才进行计算。这意味着在你选取上级菜单时，其下级菜单留空，那么显示的结果则是按当前层级的菜单进行筛选，而结果则包括其后级菜单的全部内容。换而言之，按我们之前构造的那个树形数据结构，意味着我们需要在任何一层的节点起步，遍历其下所有的节点直至末端数据。当时，由于考虑到树形结构已经固定为三层，并不多，所以我为每一层的遍历都单独写了代码，让我们来看看附件中CalAndFill这个过程的前半部，如何进行筛选的。 复制内容到剪贴板 代码: '...

lCol = dicTitle(PR_TITLE_ACPERTP)

ReDim aACPerTP(1 To UBound(aData)), aFilteredRows(1 To UBound(aData)) iCount = 0 If sState = \

aStateKeys = dicData(sLob).keys For i = 0 To dicData(sLob).Count - 1 Set dTemp = dicData(sLob)(aStateKeys(i)) aNetworkKeys = dTemp.keys For j = 0 To dTemp.Count - 1

aRows = Split(Trim(dTemp(aNetworkKeys(j)))) For k = 0 To UBound(aRows) iCount = iCount + 1

aACPerTP(iCount) = aData(Val(aRows(k)), lCol) aFilteredRows(iCount) = Val(aRows(k)) Next k Next j Next i

ElseIf sNetwork = \

Set dTemp = dicData(sLob)(sState) aNetworkKeys = dTemp.keys For i = 0 To dTemp.Count - 1

aRows = Split(Trim(dTemp(aNetworkKeys(i)))) For j = 0 To UBound(aRows) iCount = iCount + 1

aACPerTP(iCount) = aData(Val(aRows(j)), lCol) aFilteredRows(iCount) = Val(aRows(j)) Next

10

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

End Sub

是不是很简单啊。先看第一句，前三者由于是要返回数据的，所以这里没有用ByVal关键字。而第四个参数，对应我们的树形结构而言，这个就是遍历过程中途经的节点，那么它是需要被压入到递归的栈里去的，所以需要使用ByVal关键字来在内存中驻留备份，否则在二次调用后返回执行下一个内容时就会产生错误。

由于我们在之前构造树形结构时，末端节点和中间节点有个区别，就是末端节点的Item项是一个值而不是如中间节点一样是一个对象，所以上面这段代码使用IsObject函数来判断是否是末端节点。后面的代码就比较好理解了，如果不是末端节点，那么对于每个节点再次调用函数自身，如果是则将相应的信息保存到外部变量里（即前三个参数）并退出该次调用。可以通过F8逐句执行，来看看这段代码是如何进行的。

本小节复习了如何沿已知路径由根部到达某节点，了解了如何通过递归的方法来遍历某初始节点下的所有节点。

应该加一句，对于此节的例子，希望还没有完全了解代码是如何工作的朋友自己动手调整一下代码。调整的方法如下，调整后分别看看产生了什么变化，以下三个方法相互独立：

1、注释掉本节第一段代码中的后三项里的一项，看看产生什么效果 2、更改一下后三项的赋值顺序

3、在赋值最后或中间增加一句 dicLayers(PR_NAME_PROFESSIONAL) = PR_TITLE_PRODSG ，并对应的定义常数 PR_NAME_PROFESSIONAL = \，然后命名 C3 格名称为 PROF_DESGN ，最后手动执行一下 ParseData 过程更新内存。 <未完待续>

三之三、送你把漂亮的解牛小刀

说实在的，写到这里发现夹带里的代码已经基本用完了，不得不一边写代码一边调试，同时再来更新了（怎么感觉像是起点网的小说写手的话呀）。

好吧，有了前面两个小节的基础，我们其实可以写一个对于前面列出的几个案例通用的代码啦。如果你观察前面数个案例，你会发现它们都有如下的共同点：1、具有表头（废话嘛，没表头谁会知道数据是啥，傻子才不放表头呢）；2、数据是记录形式的，相对完整的，不存在空列、空行的情况（这也是通常我们组织原始数据的方式）；3、列的内容之间存在归属关系，即可以整理成树形结构。

============================

昨天半夜写的这个类，本希望能写一个通用的建立树形结构的类的，今天想着用它把前面的几个案例改写一遍，可发现：1、初始版本的末端节点代码错了（这个改正了）；2、调试半天，发现比不用它，也没方便到哪去（也可能是由于我改代码的水平比较差吧）。自己感觉这把小刀既不漂亮还挺钝的，牛估计是不太好解，杀鸡又有些浪费了

所以，决定就不再详细讨论了，不过还是把改好的1.1版放在这里，有兴趣的同学参考一下吧（那个1.0版的我删了） 三之四、上帝的归上帝，凯撒的归凯撒

好了，在我沮丧的决定放弃那把小刀后，让我用这个小节结束多层字典动态构造树形结构的讨论吧。虽然在这个小节中，我实际想聊得和字典对象的关系不大，但既然我把题目写成经验谈，那我想还是聊聊吧。

可能标题会让人不知所云，但如果我说将界面设定从代码中剥离出来并使其数据化，估计就很好理解了。让我们还是以那个保险公司的案例来看吧，我们对它已经作过两次演化了，如果你有看我前面写的内容并注意看了代码的变化，那么相信你对它的功能和特点有了较全面的了解。这一小节中，我们将继续改进它。

附件是再次修改了的代码，我增加了一个工作表，将所有Summary表中有关输出内容、输出的位置等等信息全放在了这个新的表内，并将之命名为Definition_Summary，故名思义它的功能就是用来定义Summary表的（还是让我们称之为报表吧）。这样一来，代码头部的常数部分就仅仅剩下三个了： 复制内容到剪贴板 代码:

Private Const PR_DATA_SHT_NM = \

Private Const PR_DEFINE_SHT_NM = \

Private Const PR_LOB_ALL = \

由于我们能够用代码动态的构建供索引筛选用的树形对象，那么用来定义哪些列是分层列的数组就可以从代码内剥离出来，放 在这个定义工作表中。我们来看看这个工作表的内容吧，如下图所示：

16

110526-Definition_Sheet.png (31.74 KB) 2011-5-27 02:12

纵向的分为了4段，分别是：1、菜单项定义；2、筛选内容计算结果部分；3、二次筛选结果部分；4、一个并列菜单内容。这四部分包含了几乎所有报表中需要动态显示的内容。于是原本报表中设置的名称定义就可以全部删掉了。

这里我就不再把代码贴出来详细讲如何实现的了，相信有了前文的基础，只需要看看处理定义表的部分就可以了。另外，想道个歉，附件的代码应该把读取报表定义数据的部分和其他的分开来，单独写一个过程的，而我偷懒了，全混在了一起。

还是来谈谈为什么要这么做吧，显而易见的是由于现在的代码的适用性更强了，那么如果报表的内容需要变化的时候（很不幸的是在现实生活中，报表的形式和内容都是会经常变化的，尤其当你碰到个双子座的老板的时候），我们肯定不希望去频繁的更改代码来实现。如果，象附件这样的做法，那么需要做的仅仅是在定义表内增加几行内容而已（作为例子，我在C19格显示了另一列的筛选结果平均值）。

接下来，让我们来设想一下，如果我们设计一个对话框，其中有4个Page，用来分别显示这个定义表的4栏不同的内容，同时这个对话框提供了诸如编辑、添加、删除等等功能，用以编辑这个定义表的内容。然后，将这个定义表隐藏起来，再在报表内放个按钮用来调用这个对话框。这样一来，我们实际上为这个报表提供了一个编辑保存属性值的功能。如此一来，这个动态报表就会像个独立软件一样工作了，而作为设计人员的你也不再需要为了增加一个显示内容而忙活了。

这让我想到前一阵看到有个帖子，说什么有1000个工作表的工作簿打开很慢，而又看到有人要合并1000个工作表，让我很是惊讶了一下。1000个表啊！那得是多大的数据量啊！拜读了帖子后，发现是将1000个合同文本之类的数据合并成记录形式的数据表，为什么要合并，因为那实际上是1000个报表！这这这简直是本末倒置！如果你的合同文本格式都一样，那你需要几个表？对了，2个！一个报表，一个数据表，每次填完了，按个按钮把数据填到数据表里，需要查哪个的时候再按个按钮调出来。如果你的合同文本有100个格式，那你需要几个表？嗯，如果你看了这篇文章还说101个的话就太对不起我了，几个？对了，仨！一个报表，一个数据表，还有一个报表定义表。

好了，第三节结束了，接下来的一节是我在开始写这篇文章时才想到的内容，所以目前一行代码也无，呵呵。 <未完待续>

四之一、利用字典动态的构建自定义数据类型

想必大家都很熟悉VB的一个基本功能，就是自定义数据类型，Type ... End Type。利用这个功能，我们可以将描述一个事物的各种属性都做好预先定义，从而使得程序代码更为接近自然语言。同时，在自定义数据类型内部还可以嵌套的声明某属性为另一个自定义数据类型，这样一来就可以描述更为复杂的情况。

但使用自定义数据类型有两个缺陷，其一就是它对于程序代码而言是静态的，也就是说必需要预先定义好才能使用，换而言之需要事先了解其结构。而我们在处理数据时，由于这样那样的原因，这个结构的信息会是变化的，这样一来采用自定义数据类型的办法就不适用了。

而字典对象由于是完全的代码操作，恰恰能胜任这个工作。按自定义数据类型的思路，我们可以将属性名称作为字典对象的索引关键字，而将值赋给这个字典对象元素。细心的朋友可能已经注意到，我们在前文的二之一小节中已经使用了这个方法，我还为这个案例的数据结构画了个树形图。在包号下，除了下一级节点外，还有两个关键字“CHIP”和“MASK”，是用代码直接生成的。

再以之前我们非常熟悉的那个保险公司的例子而言，由于该案例是要在筛选数据后，利用某一特定列的值的特征进行二次筛选，所以我们对末端节点的字典对象的各元素采用了行号为索引关键字，并赋值为该特定列的值。其实，我们完全可以这样来做，同样的采用行号作为末端节点各元素的索引，但将一个用字典对象创建的自定义数据类型赋值给各对应元素。这个字典对象的元素是各非树形结构层的列，其索引是列名即表头，值是对应的该行的值。这样一来，这个树结构就包含了全部源数据信息，而原本的那个全局变量源数据数组就不再需要了。希望这段文字的描述足够准确。

17

接下来，让我们回头再看看二之一小节中构造的这个树，为方便阅读，我把它复制过来： 复制内容到剪贴板 代码: dic (变量名) │

└─托盘型号 │ └─包号 │

├─CHIP -> CHIP 值 │

├─MASK -> MASK 值 │ └─托盘号 │

└─序列号

在这个树里，我们使用各层的编号进行区分索引。再看看我们引用这个树的数据时，即填表的时候，是按包为单位进行填写的。很显然，该包的包号是需要填写到标签里的，但这个包号信息是作为索引值放在树里，当我们将包节点整体传递到子过程的时候，由于该包节点的字典对象内没有这一信息，所以必须将包号作为一个单独的参数传递过去：FillLabelOne(iLabelNo, iPackNo, dicPack, dtPack As Date)。如果我们换个角度来理解这个事情，这意味着每个节点元素不知道自己叫什么。同样的，在我们之前构造的所有树中，任何一个节点都缺乏该节点相对树的信息，如：所在层的层名称、相对于根的路径信息等等。

如果引入了自定义数据类型的概念，那么我们在构造树的时候，就可以将这些信息全都放进来。也就是说对于任何一个节点而言，它都会是一个两层字典，第一层字典是一个自定义数据类型的概念，其包含的可能关键字是希望保留的节点信息，比如 Name（也就是该节点的索引值）、LayerName、LayerCount、甚至 PathArray，当然还有 Data，这个Data 就是第二层字典，也就是原本之前那个简单树的节点字典对象。如果觉得使用上面这些关键字的时候很麻烦，需要敲双引号、区分大小写，那完全可以设置一些常量并赋值为整数，比如 Const NODE_NAME = 1, Const NODE_LAYER_NAME = 2, Const NODE_DATA = 0 等等，现在再写代码的时候是不是会方便很多了。

昨天在网上找到一篇硕士毕业论文，利用VBA在Excel中建立决策分析系统，有兴趣的朋友可以翻翻。她是在EXCEL里画树形图，然后根据数据进行分析。很明显她不了解字典对象的这些应用，导致用了大量的精力用数组来模拟树形结构。如此看来，作为一个与IT混不搭界的我也可以拿个计算机专业的硕士学位啦。

在我们开始下一个小节之前，让我们先来看看下面这段代码： 复制内容到剪贴板 代码: Sub Test()

Dim dTemp, dic

Set dTemp = CreateObject(\ dTemp(1) = \ Set dic = dTemp Debug.Print dic(1) dTemp(1) = \ Debug.Print dic(1) Set dTemp = Nothing Debug.Print dic Is Nothing Debug.Print dic(1) dic.RemoveAll Set dic = Nothing End Sub <未完待续>

18

四之二、利用字典对象动态的构造复杂的数据结构

上小节结束我写了个简单的代码，这段代码的执行输出结果反映了什么呢？ 复制内容到剪贴板 代码: Sub Test()

Dim dTemp, dic

Set dTemp = CreateObject(\ dTemp(1) = \ Set dic = dTemp Debug.Print dic(1) dTemp(1) = \ Debug.Print dic(1) Set dTemp = Nothing Debug.Print dic Is Nothing Debug.Print dic(1) dic.RemoveAll Set dic = Nothing End Sub

先看看它表示的含义吧，代码的前两句创建了一个新的字典对象实例 dTemp，然后建立了一个元素索引为 1 值为一个字符串。然后用Set语句将这个对象赋值给了另一个变量 dic，并输出 新变量 dic 的索引为 1 的元素值。好吧到此无甚特别的。接下来，将先前的那个变量 dTemp 的 1 索引元素赋值为另一个字符串，再次 输出 新变量 dic 这个元素，我们发现 它 同步变化了。接下来，我们把初始变量 dTemp 设为 Nothing，据坛子里的很多帖子称是为了释放内存。安全起见代码先输出 新变量 dic 是否是 也同步变为 Nothing，可居然不是？！那么 再再次 输出 dic 的这个元素值，它居然还在？！

这段代码很显然的反映了至少两个事实：1、与我们通常的认识不同，Set ... = Nothing 不能释放内存！2、Set 变量1 = 变量2，并不是创建了变量2的副本，而是建立了一个类似于指针式的链接。关于是否释放内存一事，不妨执行下面的这段代码，然后观察 Stop 前后任务管理器中 EXCEL.EXE 所占内存的变化。 复制内容到剪贴板 代码:

Sub TestMemory() Dim dic, i& Stop

Set dic = CreateObject(\ Stop

For i = 1 to 10000 dic(i) = i Next Stop

Set dic = Nothing Stop End Sub

所以我们要切记一点，如果你确实需要释放字典对象占用的内存的话，记得使用RemoveAll方法，然后再将变量设为Nothing！如果是多层字典，而你又很希望彻底的释放内存，那就需要遍历所有节点，由末端至根部逐级RemoveAll啦。

而对于第2点，如果仅仅是建立了一个链接而非实例的副本，那么势必不会占用很多内存。如果成立的话，结合上一小节的内容，是不是可以将某一节点的字典中的元素指向另一个节点呢？让我们用下面的代码做个测试，并观察一下内存变化吧。 复制内容到剪贴板 代码:

Private Const NODE_NEXT = -1 Private Const NODE_PREVIOUS = 1

19

Private Const NODE_VALUE = 0 Sub BuildChain()

Dim dChain, i&, dTemp

Set dChain = CreateObject(\ For i = 1 to 1000

Set dChain(i) = CreateObject(\ dChain(i)(NODE_VALUE) = i Next Stop

For i = 1 to 1000

If i > 1 Then Set dChain(i)(NODE_PREVIOUS) = dChain(i - 1) If i < 1000 Then Set dChain(i)(NODE_NEXT) = dChain(i + 1) Next

dChain(1)(NODE_PREVIOUS) = FALSE dChain(1000)(NODE_NEXT) = FALSE Stop

Set dTemp = dChain(1) i = 0

Do While IsObject(dTemp(NODE_NEXT)) i = i + dTemp(NODE_VALUE) Set dTemp = dTemp(NODE_NEXT) Loop Debug.Print i For i = 1 to 1000 dChain(i).RemoveAll Set dChain(i) = Nothing Next Stop

dChain.RemoveAll Stop

Set dChain = Nothing End Sub

首先，我在这段代码中设置了数个断点，以便能观察内存的变化，在第一个循环建立了1000个字典实例后，和第二个循环创建链接后，内存没有明显的变化。这也验证了刚才我们的猜想。那么这段代码有什么意义吗？它创建了某种数据结构，这样的一个数据结构被称为双向链表（Double Linked List），在每一个节点中都包含了两个链接，分别指向前后两个节点。而随后由第一个节点开始，遍历了全部节点，并对所有节点的值进行了累加。昨天在网上查到这样一篇博文：VBA实现数据结构中的双向链表类，文中用两个类实现这样的链表，一个是链表的节点类，一个是操作函数类。注意，那个节点类表中，对于前后节点的链接是声明了节点类，也就是说在一个类中申明变量为自身。这在自定义数据类型中也是可以的，但问题是自定义数据类型是直接用 = 号赋值的，也就是说创建的是一个副本。而我们可以用字典对象 动态的 创建双向链表！而对于这样的一个链表的诸如插入、删除节点的程序难道不是很简单的吗，如果不需要取得节点在链中的顺序位置的话，我们仅仅使用简单的Set语句和字典对象的Remove方法就能实现。我们甚至可以在每个节点中加入 首节点 和 末节点 的链接，或则加入隔一个节点的链接，呵呵。

哈，看看我们发现了什么？动态的构建各种数据结构！为什么是各种？因为我们知道所谓的数据结构实际上是指数据间的相互依存关系，无非就是链接、先后顺序等等，字典对象全都可以实现。为什么我总是强调 动态的？因为通常情况下，数据结构都需要在代码内事先设置好相关的诸如自定义数据类型、类等工作。而字典由于在构造数据结构中，完全是在代码内部动态的完成的，这样一来如果数据本身能够描述清楚结构关系的话，我们就可以利用这一特点动态构建，并使得在更大意义上的通用代码成为可能。聊到这，我不得不说Collection对象同样可以胜任这个任务，并且在某种程度上而言可能比字典更合适。

现在让我们回过头来看看上一小节建立的稍微复杂点的树结构，我们在每个节点设置了该节点的一些信息，现在我们甚至可以在每个节点中建立前后兄弟节点、父节点的链接，或则如果你愿意的话，还可以建立一个根节点的链接！这就好比我们如果问一个

20

人他哥哥弟弟叫什么，他爸叫什么，此人肯定是知道的一样（当然如果问他八辈子祖宗叫啥他很可能不知道）。话说一个很有趣的现象，所有中文描述中都把原本英文中的中性描述变成了男性描述，Parent->父，Child->子，Sibling->兄弟，你不会看到有叫母节点、母对象、女节点、姊妹节点等等称呼的。作为对比，可以看看这篇文章，在Visual Basic编程中运用数据结构，此文中是采用自定义数据类型和数组来模拟单向链表和栈及队列的，可以设想一下如果采用字典对象来实现会是什么样的一个情况。

让我们来尝试构造更为复杂的结构吧。设想在一所高中里的所有学生，这些学生之间会存在这样或那样的关系，同学的、邻居的、亲兄弟姐妹的、表亲的、朋友的、恋人的（嗯，这个在高中不提倡哈）等等等等，要描述清楚这些关系显然很复杂，让我们将关系仅仅定义为互相是否认识。那么显然 A 是否认识 B 是个已知条件，否则我们的数学模型也就无从建起。那么我们可以建立这样的一个数据表，每个学生的姓名（假设姓名都是唯一的）是首列，而其认识的所有人的姓名用逗号隔开放在第二列。为了分析这样的一个数据，我们可以利用字典对象建立一个网状结构。每个人是一个节点并用姓名索引，其元素值也是一个字典对象，该字典由其认识的人姓名进行索引，然后链接至对应的节点。让我们尝试着写一下示意代码，如下： 复制内容到剪贴板 代码:

Function 创建关系网()

Dim dic关系网, arr源数据, arr认识的人, str姓名, dic某人节点 Dim i&, j&

arr源数据 = Sheet1.[a1].CurrentRegion

Set dic关系网 = CreateObject(\ For i = 1 To Ubound(arr源数据) str姓名 = arr源数据(i, 1)

Set dic关系网(str姓名) = CreateObject(\ Next

For i = 1 to Ubound(arr源数据) str姓名 = arr源数据(i, 1)

arr认识的人 = Split(arr源数据(i, 2), \ Set dic某人节点 = dic关系网(str姓名) For j = 0 To Ubound(arr认识的人) str姓名 = arr认识的人(j)

Set dic某人节点(str姓名) = dic关系网(str姓名) Next Next

Set 创建关系网 = dic关系网 End Function

现在，我们只需要调用这个函数就能获得一个由字典对象创建的网状结构啦。不知道大家听过这么一种说法吗，如果任何一个人想找世界上任何一个另外的人，需要经过互相认识的人的介绍不会超过6个！嗯，显然这一说法是不可能被证明的。但如果真的作为一个证明题的话，那请给我世界上每个人所认识的人的清单，至少我们能够建立一个超级网状数据模型，至于如何能够找出任何两个节点间的最短路径的问题则是算法范畴啦，不在此文讨论之列。

整个第四节的内容是我在开始这篇文章的时候才想到的，而由于我本人不是什么专业人士，所以也想不到有什么应用，权当有趣罢。

添加了个附件，期盼有人写个找出任意两点的全部不重复路径的代码。

21

结语

行文至此，也是结束的时候了。非常汗颜的是我是在最近一两个月才开始尝试使用字典对象的，十分感谢EH的众多朋友，我是在EH里才认识到这个工具的，之前虽有听说，但一直都没用过。而居然我会写这么一个长篇来介绍如何使用，现在想想都有些可笑，相信文中会有很多错漏之处，欢迎各位朋友指出。同样的也欢迎大家能共同讨论各自的发现或经验。

如果你现在问我什么是字典，那我会告诉你：字典是这样的一个工具，它具有 Add Remove RemoveAll 等等方法，由关键字和值组成，关键字是唯一的，值可以是任何一种数据类型 ........

是的，字典对象仅仅是一个工具，如果觉得顺手的话，不妨多用用。感谢阅读。 <全文完>

22

本文来源：https://www.bwwdw.com/article/k7x6.html