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

1、VBA编程技巧 之 字典对象使用经验谈（更新至四之一）字典对象使用经验谈目录前言_01 楼一、字典的基本功能_01 楼二、The Hardcore of Dictionary_02 楼二之一、多层字典对象应用案例分析 1 _16 楼二之二、多层字典对象应用案例分析 2 _30 楼三之一、动态的树形数据结构的构建_35 楼三之二、动态树形结构的遍历_54 楼三之三、送你把漂亮的解牛小刀_64 楼三之四、上帝的归上帝，凯撒的归凯撒_66 楼四之一、利用字典动态的构建自定义数据类型_68 楼前言 相信大家对字典对象已经是耳熟能详了。现在帮人写个代码如果不来个字典，出门都不好意思和人打招呼。EH里也有

2、大量的帖子详尽的介绍了字典对象的功能和各种使用方法，我大致翻过这些帖子，感觉很有必要和大家交流一下最近一段时间泡坛子、帮人家写代码得到的一些心得体会。可能更多的会聊一些编程思路的东西，所以我想这篇文章应该是给有一定基础的朋友看的，起码应该能不需要注释就能看懂代码，起码应该看过置顶贴里提到的那些帖子。一、字典的基本功能 相信字典对象最为出名的是它的关键字不重复特性，我们经常会看到这样的语句：For i=0 to UBound(arr) dic(arr(i,1)=Next 这段语句唯一的作用就是将数组的第一列数据去掉了重复项。但值得强调的是既然我们叫它字典对象，那么它就理所应当的具有翻译功能。 以

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

4、效奖金等等信息，那么可能的代码会是这样的： 复制内容到剪贴板 代码:Dim dic, arr, i&, lRow&lRow = Sheet1.a65536.End(xlUp).Rowarr = Sheet1.Range(a2:e & lRow)Set dic = CreateObject(Scripting.Dictionary)For i = 1 To UBound(arr) dic(arr(i, 2) = dic(arr(i, 2) + dic(arr(i, 5)Next=Dim dTitle, arr, i&, dicarr = Sheet1.a1.CurrentRegionSet dT

5、itle = CreateObject(Scripting.Dictionary)For i = 1 To UBound(arr, 2) dTitle(arr(1, i) = iNextSet dic = CreateObject(Scripting.Dictionary)For i = 2 To UBound(arr) dic(arr(i, dTitle(班组) = dic(arr(i, dTitle(班组) + arr(i, dTitle(绩效奖金)Next第二段代码我们使用了一个名为dTitle的字典对象来记录表头名称和对应列号，这样当我们需要使用某列数据的时候，我们可以使用这个对象来将

6、表头名翻译成列号。很明显的是第一段代码完全依赖于表格内容的地理位置，而且如果不去看数据表的话，你根本不知道它在干什么。而相应的，对于第二段代码而言，我们完全可以不用去了解数据表是什么样的，只需要知道它有这样的两个表头就可以了。并且你不觉得它很接近自然语言了吗？哦，不吗，你确定？那我再稍微改一下： 复制内容到剪贴板 代码:数据 = Sheet1.a1.CurrentRegionSet 表头之列号 = CreateObject(Scripting.Dictionary)For i = 1 To UBound(数据, 2) 表头之列号(数据(1, i) = iNextSet 班组绩效奖金 = Cre

7、ateObject(Scripting.Dictionary)For i = 2 To UBound(数据) 班组名 = 数据(i, 表头之列号(班组) 成员绩效奖金 = 数据(i, 表头之列号(绩效奖金) 班组绩效奖金(班组名) = 班组绩效奖金(班组名) + 成员绩效奖金Next如果出于某些原因，原来的那个工资表在绩效奖金之前增加了一列，比如说老板大发善心为大家增发了住房津贴，显然作为劳资统计的你不会希望把它给漏了。那么这时，如果你的代码是前面第一种方法，那么你必须仔细检查你的代码，确保每一个数字对应的列是你需要的内容。但是如果你非常幸运的看过了这篇文章，并且使用了第二种方法，恭喜你，你不

8、用像前者那样心惊胆颤的一个个数列数了，开开心心的在一边数钱吧！可能有看官说了：嘿，我们老板才烦呢，他不会加发工资的，他会把那个绩效奖金的名字改成工作表现奖！你瞧，这下你要去改代码了吧。那么这里我想说的是，养成良好的编程习惯，使用常量设置。如果你经常写代码的话，你肯定会碰到前面这位看官提到的情况，那么你就会知道使用常量设置是多么方便的事情。千万不要为了少敲键盘而省略这个过程，我们要牢记我军的优良训练传统：训练多流汗，战时少流血！编写多常量，更改不挠头！想想还是把代码写出来看看效果吧： 复制内容到剪贴板 代码:Public Const PR_SALARY_GROUP = 班组Public Cons

9、t PR_SALARY_BONUS = 绩效奖金.Dim dTitle, arr, i&, dicarr = Sheet1.a1.CurrentRegionSet dTitle = CreateObject(Scripting.Dictionary)For i = 1 To UBound(arr, 2) dTitle(arr(1, i) = iNextSet dic = CreateObject(Scripting.Dictionary)For i = 2 To UBound(arr) dic(arr(i, dTitle(PR_SALARY_GROUP) = _ dic(arr(i, dTit

10、le(PR_SALARY_GROUP) + arr(i, dTitle(PR_SALARY_BONUS)Next二、The Hardcore of Dictionary 琢磨了半天，还真没想出什么中文词来表达Hardcore比较合适。（题外话，不建议去Google搜索这个关键字，但相信我这个词本身没有任何相关的含义，真的是个好词。） 我们知道字典对象由关键字 Key 和数据项 Item 构成。通常情况下 Key 是字符串，实际上也可以是其它数据类型，比如整数、小数等。而数据项则可以是任何数据类型，包括字典对象本身。这样我们就可以创建多层的字典对象了。利用多层字典对象，我们可以实现诸如级联菜单、

11、联动数据有效性序列、联动下拉框等等应用，这也常见于坛子里各个帖子。这里我不想重复谈这些应用，而是想着重强调其背后隐藏的一个概念。 我们到底用字典作了什么？一言以蔽之，所谓的多层字典，实际上你利用它构造了一个树型数据结构！ 坛子里也有很多帖子在介绍TreeView这个控件，它和我们的多层字典何其相似。让我们还是以上面那个工资表来作为例子，我们可能希望把它处理成这样的一个形式： 复制内容到剪贴板 代码:Public Const PR_SALARY_GROUP = 班组Public Const PR_SALARY_POSITION = 工位Public Const PR_SALARY_NAME =

12、姓名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(Scripting.Dictionary) For i = 1 To UBound(arr, 2) dTitle(arr(1, i) = i Next Set dic = CreateObject(Scripting.Dict

13、ionary) 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(Scripting.Dictionary) 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_

14、SALARY_POSITION) = CreateObject(Scripting.Dictionary) 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(Scripting.Dictionary) Set dTemp = dTemp(arr(i, dTitle(PR_SALARY_NAME) dTemp(PR_SAL

15、ARY_BASE) = arr(i, dTitle(PR_SALARY_BASE) dTemp(PR_SALARY_BONUS) = arr(i, dTitle(PR_SALARY_BONUS) Next Set ParseData = dic Set dTitle = NothingEnd Function如果我们使用类似这样的语句 Set dicSalary = ParseData() 调用上面这个程序，那么我们可能得到的一个数据结构，会是如下这样子的： 复制内容到剪贴板 代码:dicSalary 甲班 拼装 张三 基本工资 - $1000 绩效奖金 - $800 李四 基本工资 - $1

16、000 绩效奖金 - $800 焊接 王二麻子 基本工资 - $1100 绩效奖金 - $900 赵大 基本工资 - $1100 绩效奖金 - $900 乙班 拼装 诸葛 基本工资 - $1000 绩效奖金 - $800 南宫 基本工资 - $1000 绩效奖金 - $800 焊接 西门 基本工资 - $1100 绩效奖金 - $900 轩辕 基本工资 - $1100 绩效奖金 - $900那么，对于这样一个数据结构，我们调用张三的基本工资就会是这样子的：张三的基本工资 = dicSalary(甲班)(拼装)(张三)(基本工资) 当然，我们也可以使用自定义类型来实现这一目的，代码可能会是象下面

17、这个样子： 复制内容到剪贴板 代码:Public Type Salary Name As String Amount As SingleEnd TypePublic Type Person Name As String Salaries() As SalaryEnd TypePublic Type Position Name As String Persons() As PersonEnd TypePublic Type Group Name As String Positions() As PositionEnd Type这里，我不想再去写赋值代码，因为那实在是一个非常繁琐的过程。不过我们可

18、以想象一下这个赋值的过程，我们需要重新定义每层的数组元素数量，可能还需要通过循环来定位是数组的第几个元素。而反过来当我们需要调用某个值得时候，也同样的啰嗦。这时我们可以非常明显的看到使用字典对象的方便了，因为字典对象让我们可以用关键字来进行索引，而不需要对整个元素集合进行顺序遍历来查找定位。提到集合，实际上我们还可以使用VBA原生的一个对象，就是集合对象（Collection），来实现这一目的。但这里存在一个问题，集合对象没有 Exists 方法，也就是说你无法知晓某个关键字是否存在，只能通过 On Error Resume Next，引用此关键字，再去判断 Err.Number 0 来得到答

19、案，同时还要再清除这个错误，会麻烦不少。不过这里不得不提一下集合对象的一个优势，那就是在它的Add方法支持 After/Before 参数，使得在初始赋值时，非常适合同时进行排序工作，如果你需要对你的树结构进行排序的话，建议你考虑用Collection对象。看到这，相信你已经完全了解了字典对象在构造树形结构方面的优势。有必要在这里解释一下，为什么这种数据结构非常重要。通过上面的树形图，想必很容易理解这种结构清晰的反映了数据间的归属关系或是上下级关系。而在现实生活中，我们几乎可以用这种结构来描述各种事物，公司的人员结构、文档的归类整理、你家的门牌号，等等等等。这也是为什么我们在EH的VBA版看到

20、大量的字典对象应用的根本原因，因为它太适合用来处理最常见的各种数据了。接下来，我会结合具体的案例，来聊聊字典是如何处理树形结构数据的。二之一、多层字典对象应用案例分析 1 这里我们以一个跟据已有标签内容数据、创建格式化标签供打印用的实际案例，来聊聊使用多层字典对象构造树形数据结构如何解决问题的。这个例子的帖子地址：/viewthread.php?tid=720876 为避免由于楼主编辑帖子，我把他的原始附件和最后我帮他完成的附件都贴在这里。有兴趣的同学也可以去这个贴子看看，我在11楼提到的楼主代码的问题其实就是一些经验之谈。看看楼主原来的附件里的

21、代码，你会发现他是在用Select Case语句完成字典的翻译功能，这样的做法违背了一个编程的基本原则，混淆了代码和数据的区别。正如我在该贴11楼提到的，他的SN（Serial Number）和Mask（某种规格）、Tray Type（托盘型号）之间存在着多对一的关系，即SN确定则后两者都是确定的。这种情况下，这样关系太适合用字典来描述了，同时这种关系本身是数据的，那么理应让它成为数据，所以我才要求楼主准备这样一个对照表。可能有朋友会发现我比较啰嗦，但实际情况说明作为一个在EH的VBA版帮人写代码的家伙，适当的和楼主交流是多么的必要。这就和你作为一个销售人员，在商业谈判中穿插着聊一些有趣的话题

22、同时进一步了解客户需求的道理是一样的，即增进了感情又能掌握更多的信息，避免走弯路，呵呵。 还是回到这个小节的主题上来，我们先来分析一下这个例子里的数据是什么样的一个结构。 1、标签的数据有了，而且是按通常的数据库结构建立的，即表头、记录 2、标签的结构有两种，是按托盘型号区分的 3、标签是按包打印的，即每包一个标签，而同一包的芯片对应的Mask和Chip这两个值都是一样的 4、每包内又有数个托盘，每个托盘有数个芯片即序列号看到这里，相信你也同样的发现这就是一个典型的树形结构，它的数据归属关系应该是这样子的：托盘型号 - 包号 - 托盘号 - 芯片。为此，我写了这样的一个过程来构造这个标签数据结

23、构，如下： 复制内容到剪贴板 代码: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(Scripting.Dictionary) For i = 1 To UBound(aData) If Not dic.exists(aData(i, MPL_COL

24、_TYPE) Then _ Set dic(aData(i, MPL_COL_TYPE) = CreateObject(Scripting.Dictionary) 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(Scripting.Dictionary) Set dTemp = dTemp(aData(i, MPL_COL_PACK) dTemp(CHIP) = aDat

25、a(i, MPL_COL_CHIP) dTemp(MASK) = aData(i, MPL_COL_MASK) If Not dTemp.exists(aData(i, MPL_COL_TRAY) Then _ Set dTemp(aData(i, MPL_COL_TRAY) = CreateObject(Scripting.Dictionary) Set dTemp = dTemp(aData(i, MPL_COL_TRAY) dTemp(aData(i, MPL_COL_SN) = True Next Set ParseData = dicEnd Function为了更加直观的表达这段代码

26、，让我们来给它画个树形图 复制内容到剪贴板 代码:dic (变量名) 托盘型号 包号 CHIP - CHIP 值 MASK - MASK 值 托盘号 序列号话说我们在处理EXCEL数据时，绝大多数的情况都可以分为三个步骤，即 读取整理数据、计算构造输出数据、输出结果，前者和后者会和EXCEL工作表交互，而中间的那个步骤则是在内存中完成的。我们知道数据结构决定了算法，也就是说第一步的读取整理数据决定了中间的计算和后面的输出的代码难易度。上面这段代码的作用就是把原始的数据记录构造成了上图示意的一个树形数据结构，这也是为什么我把这段程序命名为ParseData而不是ReadData的原因。说起来这个

27、问题，如果你碰到要编程序处理数据了，一时想不好该干些什么，我告诉你可以先写象这样的几行代码，肯定没错的： 复制内容到剪贴板 代码:Public Sub 我要炒股票挣钱() Call 读取分析股票数据 ParseData Call 计算哪个股票挣钱 CalData Call 告诉我是哪个股票 OutputResultEnd Sub是不是看上去很简单啊，事实上就是这么简单的。我们接着来看看此例中，CreateLabels是怎么工作的，它的代码如下： 复制内容到剪贴板 代码:Public Sub CreateLabels() Dim dic, aTrayTypes, i%, j%, dTemp, a

28、Packs, 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) Fil

29、lLabelOne 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 = NothingEnd Sub你瞧，整个过程如果用语言来描述的话，就像这样：1、读取分析数据；2、清空标签模版内容；3、按需要复制空白标签模版；4、逐个填写标签内容。如果你有一定的英文基础的话，上面这段代码你

30、甚至不需要任何注释就能轻易看明白，难道不是吗？这里我想说一下另外一个良好的编程习惯：遵循一定的变量命名规则。每个人都会有自己的命名习惯，但我想说的是让这种习惯遵循一定的规则，并尽可能的让它表达自身的含义。我注意到坛子里很多高手都喜欢用单字符、双字符命名变量，他们自己完全搞得清楚，那是因为他们是高手而且是自己写的不长的代码。但我真的很想告诉你，那其实是一个非常非常坏的习惯，甚至都不需要长时间以后再去理解代码，仅仅是需要写一个长点的代码，就会让你感觉云山雾罩了，而不得不写很多的注释来告诉自己这段是干嘛的那段是干嘛的。另外一个技巧就是把你的代码中相对独立的片断，拎出来单独写个过程或是函数，其好处不仅

31、仅是避免重复的代码，更大的好处是让你可以更为专注的解决一个相对独立的功能而不用去考虑全局的情况，给这个过程起一个恰当的名字，同样会让你的代码更容易看懂，让你的代码会说话。有兴趣的朋友可下载此节开头提到的帖子里4楼的附件，那是一开始我为楼主写的代码，因为最初楼主只是提到了一种标签，估计他的想法是学习一下实现方法然后自己作的，呵呵。还是回到主题，我们已经构造了合适的数据结构，已经准备好了空白的标签，接下来要做的无非就是把相应的数据填进去就行了。以第一种标签为例，填写一个空白标签的代码如下： 复制内容到剪贴板 代码:Private Sub FillLabelOne(iLabelNo, iPackNo

32、, dicPack, dtPack As Date) Dim iRow%, iCol%, i%, j%, aTrays, aHead, aCont, iChipNum%, dTray, aSNs 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 U

33、Bound(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)

34、Mod 3) * 5 + 2) = aSNs(j) iChipNum = iChipNum + 1 Next Next aHead(1, 1) = iPackNo aHead(2, 1) = dicPack(CHIP) aHead(2, 10) = dicPack(MASK) 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) *

35、(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 WithEnd Sub这段代码的作用就是填写一个空白标签，结合前面说到的专注的问题，如果我们把这段代码放回到CreateLabels里并不是做不到，但你会发现那样一来，你的代码就会

36、变得很啰嗦。你需要定位填写的标签，并且需要把这些定位反映到代码里。而如果分离出来，通过参数把需要的信息传递过来，那么你仅仅需要考虑填写一个标签的问题就可以了。这段代码是将标签分为两部分填写的，头部和下方的详细内容。实际上，几乎任何一个描述类似事情的表格都可以这样来区分，诸如 报关单、工资表、发货清单、加工清单等等，你都可以采用同样的办法，使用字典对象建立一个树形结构，整理成你希望的形式并输出。这里使用的是一个Variant型的数组输出到工作表的，因为标签模版的形式是希望没有数据的地方留为空白，而Variant型数组正好可以实现这一要求，对于没有赋值的数组元素在输出到工作表时，对应的单元格是不填

37、任何东西的。具体到内部的计算，无非就是按照模版的结构，对相应的数组元素赋值的过程，这里就不详细讲了。此节附件里，还有两个字典对象的应用，一个是根据输入的SN信息，结合包装的特性，生成分包清单；另一个是在输入SN过程中，利用一个全局变量字典对象，检查是否已经存在该SN，以避免重复。有兴趣的朋友可以参考一下。二之二、多层字典对象应用案例分析 2 接下来这个例子是一家保险公司的数据，希望从已有的数据中根据不同的客户类别、地理位置和是否在销售网络中的属性这三个不同层级，来筛选数据，动态的将筛选结果显示在一个工作表内。帖子的地址是：/viewthread.

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

39、分析一下现有的数据。如前所述，我们需要根据需要动态筛选数据，这一过程其实也可以手动完成的，筛选条件如下：1、客户类别 LOB（没猜错的话是 Label Of Business）；2、地理位置，即州别，Phy State（没猜错的话 是 Physician State）；3、是否在网络中，In Network（估计指的是销售网络），对于筛选出来的记录，我们需要对其中一列数据（Allowed Costs/Treated Patients，猜测是指每个治愈患者的允许费用）计算一些诸如最大最小值、平均值、方差等，然后需要进一步根据计算结果，将该列数据中大于某种平均值的记录筛选出来，并进一步计算平均值和

40、列出筛选结果。楼主在需要显示结果的表Summary内，已经规划好了显示位置，以及用户交互方式，及使用单元格数据有效性提供的下拉框，形成菜单式选项。很明显的第一步筛选过程，其实也是一个树形结构，也就是说完全可以使用多层字典对象来实现，有了前面的基础，这里我就不画树形图了，层级关系就上面的1、2、3的顺序。那么ParseData过程的代码就是下面这个样子的： 复制内容到剪贴板 代码:Private Sub ParseData() Dim i&, lRowMax&, lColMax&, dTemp, aTitle lRowMax = Sheets(PR_DATA_SHT_NM).a1.End(xlD

41、own).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(scripting.dictionary) Set dicTitle = CreateObject(scripting.dictionary) For i = 1 To UBou

42、nd(aTitle, 2) dicTitle(aTitle(1, i) = i Next Set dicData(PR_LOB_ALL) = CreateObject(scripting.dictionary) 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(scripting.dictionary) Set dTemp = dicData(aD

43、ata(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(scripting.dictionary) Set dTemp = dTemp(aData(i, dicTitle(PR_TITLE_STATE) dTemp(aData(i, dicTitle(PR_TITLE_NETWORK) = dTemp(aData(i, dicTitle(PR_TITLE

44、_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(scripting.dictionary) Set dTemp = dTemp(aData(i, dicTitle(PR_TITLE_STATE) dTemp(aData(i, dicTitle(PR_TITLE_NETWORK) = dTemp(aData(i,

45、 dicTitle(PR_TITLE_NETWORK) & i & NextEnd Sub有了前文介绍的使用表头索引行号的概念、常量的概念、构造树形数据结构的概念，相信读懂这段代码应该不难。这里有三点需要说明一下，1、楼主对于LOB项有个要求，除了表内现有内容外，增加了一个All选项用来显示全部客户类别的信息，所以我们在代码内，定义了一个PR_LOB_ALL这个常量索引，并使它和其它LOB项内容同级；2、由于还要对筛选结果进行二次筛选，而且还要列出源数据表中其它列的内容，所以这里在树形结构的末端，我们采用了字符串的方式来索引每个分支对应的行号，行号之间是由空格分开的，由于最后会多出一个空格，所

46、以在后面引用它的时候，要使用Trim函数把它去掉，然后用Join函数把这个字符串变成数组；3、由于要动态的显示筛选结果，所以我将 标题字典（dicTitle）、树形结构字典（dicData）、数据数组（aData）这三者都设置成了全局变量，也就是说在内存里制作了一个源数据表的副本，并且根据我们的需要，使用字典对象对它进行了索引。这其实是一个典型利用内存空间换取执行速度的方法，要知道对于内存中驻留的数据进行计算的操作要比从任何形式的其它位置读一次数据要快的多，也就事实上使得人们在交互时产生结果实时动态显示的感觉。好了，我们已经构造好了我们的树形结构，并且对数据数组进行了索引，那么接下来要做的工作

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

48、cTitle(PR_TITLE_ACPERTP) ReDim aACPerTP(1 To UBound(aData), aFilteredRows(1 To UBound(aData) iCount = 0 If sState = Then 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(T

49、rim(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 = Then 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 aACPer