一、字典的基本功能

相信字典工具最为出名的是它的关键字不重复特性,我们常常会看到这样的语句:

For i=0 to UBound(arr)

php有treeview吗Excel字典对象仅仅是一个对象假如认为随手的话不妨多用用 NoSQL

dic(arr(i,1))=\"大众\"大众

Next

这段语句唯一的浸染便是将数组的第一列数据去掉了重复项。
但值得强调的是既然我们叫它字典工具,那么它就理所应该的具有翻译功能。

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

让我们来比较两段代码,设想我们须要读取一个月人为表并统计各班组的绩效奖金,其包含 姓名、班组、工位、基本人为、绩效奖金等等信息,那么可能的代码会是这样的:

Dim dic, arr, i&, lRow&

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

arr = 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&, dic

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.Dictionary\公众)

For i = 2 To UBound(arr)

dic(arr(i, dTitle(\"大众班组\"大众))) = dic(arr(i, dTitle(\"大众班组\公众))) + arr(i, dTitle(\"大众绩效奖金\公众))

Next

第二段代码我们利用了一个名为dTitle的字典工具来记录表头名称和对应列号,这样当我们须要利用某列数据的时候,我们可以利用这个工具来将表头名翻译成列号。
很明显的是第一段代码完备依赖于表格内容的地理位置,而且如果不去看数据表的话,你根本不知道它在干什么。
而相应的,对付第二段代码而言,我们完备可以不用去理解数据表是什么样的,只须要知道它有这样的两个表头就可以了。
并且你不以为它很靠近自然措辞了吗?哦,不吗,你确定?那我再轻微改一下:

数据 = Sheet1.[a1].CurrentRegion

Set 表头之列号 = CreateObject(\公众Scripting.Dictionary\公众)

For i = 1 To UBound(数据, 2)

表头之列号(数据(1, i)) = i

Next

Set 班组绩效奖金 = CreateObject(\公众Scripting.Dictionary\"大众)

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(\"大众Scripting.Dictionary\"大众)

For i = 1 To UBound(arr, 2)

dTitle(arr(1, i)) = i

Next

Set dic = CreateObject(\"大众Scripting.Dictionary\公众)

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

琢磨了半天,还真没想出什么中文词来表达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(\公众Scripting.Dictionary\公众)

For i = 1 To UBound(arr, 2)

dTitle(arr(1, i)) = i

Next

Set dic = CreateObject(\"大众Scripting.Dictionary\"大众)

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_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_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

├─甲班

│ ├─拼装

│ │ ├─张三

│ │ │ ├─基本人为 -> $1000

│ │ │ │

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

│ │ │

│ │ └─李四

│ │ ├─基本人为 -> $1000

│ │ │

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

│ │

│ └─焊接

│ ├─王二麻子

│ │ ├─基本人为 -> $1100

│ │ │

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

│ │

│ └─赵大

│ ├─基本人为 -> $1100

│ │

│ └─绩效奖金 -> $900

└─乙班

├─拼装

│ ├─诸葛

│ │ ├─基本人为 -> $1000

│ │ │

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

│ │

│ └─南宫

│ ├─基本人为 -> $1000

│ │

│ └─绩效奖金 -> $800

└─焊接

├─西门

│ ├─基本人为 -> $1100

│ │

│ └─绩效奖金 -> $900

└─轩辕

├─基本人为 -> $1100

└─绩效奖金 -> $900

那么,对付这样一个数据构造,我们调用张三的基本人为就会是这样子的:

张三的基本人为 = dicSalary(\"大众甲班\"大众)(\公众拼装\"大众)(\"大众张三\"大众)(\"大众基本人为\"大众)

当然,我们也可以利用自定义类型来实现这一目的,代码可能会是象下面这个样子:

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版看到大量的字典工具运用的根本缘故原由,由于它太适宜用来处理最常见的各种数据了。

接下来,我会结合详细的案例,来聊聊字典是如何处理树形构造数据的。

二之二、多层字典工具运用案例剖析 2

接下来这个例子是一家保险公司的数据,希望从已有的数据中根据不同的客户种别、地理位置和是否在发卖网络中的属性这三个不同层级,来筛选数据,动态的将筛选结果显示在一个事情表内。
帖子的地址是:[url]http://club.excelhome.net/viewthread.php?tid=720328[/url] 。
这个帖子偏长,除了由于楼主后来又增加了哀求以外,更大的缘故原由是由于我写代码不仔细,缺点的将一个循环变量 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(\"大众scripting.dictionary\公众)

Set dicTitle = CreateObject(\公众scripting.dictionary\"大众)

For i = 1 To UBound(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(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(\公众scripting.dictionary\公众)

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(\"大众scripting.dictionary\"大众)

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

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

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 = \"大众\"大众 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(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 = \"大众\"大众 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

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

aFilteredRows(iCount) = Val(aRows(j))

Next

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(\"大众本月人为\"大众) > 100000 Then Call 去新马泰(\"大众三日游\公众) 是啥意思,而很丢脸懂 If Range(\"大众A1\"大众) = 1000 Then Call 本月只能吃馒头 是为什么),其余一个好处是这个名称定义是随着被定义单元格的位置变革的,也便是说当调度告终构后,无需修正代码。
其余,这个工具比较可气的是,当判断一个单元格或是Range是否有定义了名称时,我没找到什么好办法(可能没负责找过),不得不采取这样的代码:

On Error Resume Next

sName = Target.Name.Name

On Error GoTo 0

If sName = ... Then

...

End If

这里的第一个.Name是返回一个名称工具,第二个.Name则返回这个名称工具的名字。

三之一、动态的树形数据构造的构建

本想起一个酷点的名字,实在是没啥创意,老诚笃实的写吧。
这一节算是个过渡吧,会是结合一个例子来讲。

在前面第二节,我们已经建立了一个观点,即利用多层字典工具来布局一个树形的数据构造。
在此后的两个案例中,须要把稳一个征象,即这两个树形构造其层次的数量是固定的。
但在现实活动中,我们常常会碰到这样的情形,即树形构造的层数不固定。
在第二节中,我还先容了如何用自定义数据类型的方法来布局树形构造,但对付如果层数不固定的情形,这种方法就无法运用了。
而字典之以是强大,便是由于它布局数据构造的过程是利用代码实现的,这也就一定的使得它能够胜任动态布局的事情。

让我们结合一个例子来聊聊如何动态布局树形构造。
这个例子是利用字典创建多层级联菜单(实际上是数据有效性供应的下拉选项,和菜单的观点一样),而菜单和层级内容则来自事情表记录的内容,也就说须要布局的多层字典的层数不固定。

实际上这个例子的代码非常短(相较于前面两个案例而言,我创造自己不只回帖写贴啰嗦,写代码也啰嗦),撤除那个设置数据有效性的过程外,全部代码如下(当然不算Sheet1里的那些代码,那些是界面层面的内容,不属于我们目前谈论的范畴):

Public dMenuTitle '用来记录级联内容标题的字典(记录列号),简称标题字典

Public dMenuItems '用来记录级联内容的字典(多层),简称内容字典

Public Sub RenewMenuDic(ByVal ShtName$)

1: Dim arr, iColMax%, lRowMax&, i&, j&, sTitle$, dTemp

2: Set dMenuItems = Nothing: Set dMenuTitle = Nothing

3: Set dMenuItems = CreateObject(\"大众scripting.dictionary\"大众)

4: Set dMenuTitle = CreateObject(\"大众scripting.dictionary\"大众)

5: If Sheets(ShtName).[a1] = \"大众\"大众 Then Exit Sub '由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) & \"大众\"大众) = i: Next

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(\"大众scripting.dictionary\"大众) '如果是新的,添加新字典作为项目

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(\"大众Scripting.Dictionary\"大众) 实际上和 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(\公众scripting.dictionary\"大众)

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的文件构造是个非常好的树形构造例子。
如果参考一下前面二之二节的那个案例,我们会创造在遍历这样的树形构造时,我们碰到了一个问题,那便是层的数量未知,而且层数可能会非常大。
这样一来,势必不能通过大略的循环嵌套的办法来实现,最为简便的办法便是递归

言归正传,由于我一开始没有料到该帖楼主会哀求变动级联菜单的数量,以是在布局多层字典的时候是逐级向下写代码的,而在后续处理数据后的遍历读取时,又采取了嵌套循环的办法。
这样子一来,再增加级联层数就会导致险些所有的代码都须要改动,而且随着层数的增加,其后续的遍历就会越来越麻烦。
于是我引入了动态构建树形构造的办法,下面我们来逐段剖析这个例子里的ParseData。

'定义级联层数

Set dicLayers = CreateObject(\"大众scripting.dictionary\"大众)

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(\"大众scripting.dictionary\"大众)

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(\公众scripting.dictionary\"大众)

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, 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

End Sub

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

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

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

该当加一句,对付此节的例子,希望还没有完备理解代码是如何事情的朋友自己动手调度一下代码。
调度的方法如下,调度后分别看看产生了什么变革,以下三个方法相互独立:

1、注释掉本节第一段代码中的后三项里的一项,看看产生什么效果

2、变动一下后三项的赋值顺序

3、在赋值末了或中间增加一句 dicLayers(PR_NAME_PROFESSIONAL) = PR_TITLE_PRODSG ,并对应的定义常数 PR_NAME_PROFESSIONAL = \"大众PROF_DESGN\公众 ,然后命名 C3 格名称为 PROF_DESGN ,最夹帐动实行一下 ParseData 过程更新内存。

三之三、送你把俊秀的解牛小刀

说实在的,写到这里创造夹带里的代码已经基本用完了,不得不一边写代码一边调试,同时再来更新了(怎么觉得像是出发点网的小说写手的话呀::L )。

好吧,有了前面两个小节的根本,我们实在可以写一个对付前面列出的几个案例通用的代码啦。
如果你不雅观察前面数个案例,你会创造它们都有如下的共同点:1、具有表头(废话嘛,没表头谁会知道数据是啥,傻子才不放表头呢);2、数据是记录形式的,相对完全的,不存在空列、空行的情形(这也是常日我们组织原始数据的办法);3、列的内容之间存在归属关系,即可以整理成树形构造。

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

昨皇帝夜写的这个类,本希望能写一个通用的建立树形构造的类的,本日想着用它把前面的几个案例改写一遍,可创造:1、初始版本的末端节点代码错了(这个改正了);2、调试半天,创造比不用它,也没方便到哪去(也可能是由于我改代码的水平比较差吧)。
自己觉得这把小刀既不俊秀还挺钝的,牛估计是不太好解,杀鸡又有些摧残浪费蹂躏了::L

哇咔咔,找到个例子用小刀切了,效果还蛮不错的呀,3万7千行遍历末端节点进行筛选、加总,用时也不过1秒多,完备可以接管呀。
为了上传,保留2万余。

主程序代码如下:Sub AnalizeData()

Dim dtTree As New DataTreeClass

Dim aMenu, sGood$, sBad$, aOutput, aPath

Dim iYear%, sMonth$, sItem$

Dim lSubGood&, lSubBad&

Dim i&, j&

Dim t!

t = Timer

With Sheet2

aMenu = Array(.Cells(1, 1) & \"大众\公众, .Cells(1, 2) & \公众\"大众, .Cells(1, 7) & \公众\"大众)

sGood = .Cells(1, 10) & \"大众\公众

sBad = .Cells(1, 11) & \"大众\公众

End With

With Cells(1, 1).CurrentRegion

ReDim aOutput(1 To .Rows.Count - 1, 1 To .Columns.Count - 1)

End With

Cells(2, 2).Resize(UBound(aOutput, 1), UBound(aOutput, 2)).ClearContents

With dtTree

.Initialize Sheet2.Name, aMenu, 1, 1, sGood

For i = 1 To UBound(aOutput, 2)

iYear = Year(Cells(1, i + 1))

sMonth = Format(Cells(1, i + 1), \"大众mmm\公众)

For j = 1 To UBound(aOutput, 1)

sItem = Cells(j + 1, 1)

aPath = Array(iYear, sMonth, sItem)

.CurrentNodePath = aPath

lSubGood = 0

If Len(.CurrentNodeName) > 0 Then

lSubGood = Application.Sum(.GetChildrenItemsData(, sGood))

lSubBad = Application.Sum(.GetChildrenItemsData(, sBad))

If lSubGood > 0 Then

aOutput(j, i) = lSubBad / lSubGood

End If

End If

Next

Next

End With

Cells(2, 2).Resize(UBound(aOutput, 1), UBound(aOutput, 2)) = aOutput

Set dtTree = Nothing

MsgBox Timer - t & \"大众秒\"大众

End Sub

三之四、上帝的物化主,凯撒的归凯撒

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

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

附件是再次修正了的代码,我增加了一个事情表,将所有Summary表中有关输出内容、输出的位置等等信息全放在了这个新的表内,并将之命名为Definition_Summary,故名思义它的功能便是用来定义Summary表的(还是让我们称之为报表吧)。
这样一来,代码头部的常数部分就仅仅剩下三个了:

Private Const PR_DATA_SHT_NM = \"大众Data\"大众

Private Const PR_DEFINE_SHT_NM = \"大众Definition_Summary\"大众

Private Const PR_LOB_ALL = \"大众All\公众

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

[attachimg]930002[/attachimg] 纵向的分为了4段,分别是:1、菜单项定义;2、筛选内容打算结果部分;3、二次筛选结果部分;4、一个并列菜单内容。
这四部分包含了险些所有报表中须要动态显示的内容。
于是原来报表中设置的名称定义就可以全部删掉了。

这里我就不再把代码贴出来详细讲如何实现的了,相信有了前文的根本,只须要看看处理定义表的部分就可以了。
其余,想道个歉,附件的代码该当把读取报表定义数据的部分和其他的分开来,单独写一个过程的,而我偷

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

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

这让我想到前一阵看到有个帖子,说什么有1000个事情表的事情簿打开很慢,而又看到有人要合并1000个事情表,让我很是惊异了一下。
1000个表啊!
那得是多大的数据量啊!
拜读了帖子后,创造是将1000个条约文本之类的数据合并成记录形式的数据表,为什么要合并,由于那实际上是1000个报表!
这这这切实其实是本末倒置!
如果你的条约文本格式都一样,那你须要几个表?对了,2个!
一个报表,一个数据表,每次填完了,按个按钮把数据填到数据表里,须要查哪个的时候再按个按钮调出来。
如果你的条约文本有100个格式,那你须要几个表?嗯,如果你看了这篇文章还说101个的话就太对不起我了,几个?对了,仨!
一个报表,一个数据表,还有一个报表定义表。

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

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

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

但利用自定义数据类型有两个毛病,其一便是它对付程序代码而言是静态的,也便是说必需要预先定义好才能利用,换而言之须要事先理解其构造。
而我们在处理数据时,由于这样那样的缘故原由,这个构造的信息会是变革的,这样一来采取自定义数据类型的办法就不适用了。

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

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

接下来,让我们转头再看看二之一小节中布局的这个树,为方便阅读,我把它复制过来:

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 等等,现在再写代码的时候是不是会方便很多了。

在我们开始下一个小节之前,让我们先来看看下面这段代码:

Sub Test()

Dim dTemp, dic

Set dTemp = CreateObject(\公众Scripting.Dictionary\"大众)

dTemp(1) = \"大众Here you are!\"大众

Set dic = dTemp

Debug.Print dic(1)

dTemp(1) = \公众Here I am!\公众

Debug.Print dic(1)

Set dTemp = Nothing

Debug.Print dic Is Nothing

Debug.Print dic(1)

dic.RemoveAll

Set dic = Nothing

End Sub

四之二、利用字典工具动态的布局繁芜的数据构造

上小节结束我写了个大略的代码,这段代码的实行输出结果反响了什么呢?

Sub Test()

Dim dTemp, dic

Set dTemp = CreateObject(\公众Scripting.Dictionary\公众)

dTemp(1) = \公众Here you are!\"大众

Set dic = dTemp

Debug.Print dic(1)

dTemp(1) = \公众Here I am!\"大众

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(\"大众Scripting.Dictionary\"大众)

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

Private Const NODE_VALUE = 0

Sub BuildChain()

Dim dChain, i&, dTemp

Set dChain = CreateObject(\"大众Scripting.Dictionary\"大众)

For i = 1 to 1000

Set dChain(i) = CreateObject(\"大众Scripting.Dictionary\公众)

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),在每一个节点中都包含了两个链接,分别指向前后两个节点。
而随后由第一个节点开始,遍历了全部节点,并对所有节点的值进行了累加。
把稳,那个节点类表中,对付前后节点的链接是声明了节点类,也便是说在一个类中申明变量为自身。
这在自定义数据类型中也是可以的,但问题是自定义数据类型是直接用 = 号赋值的,也便是说创建的是一个副本。
而我们可以用字典工具 动态的 创建双向链表!
而对付这样的一个链表的诸如插入、删除节点的程序难道不是很大略的吗,如果不须要取得节点在链中的顺序位置的话,我们仅仅利用大略的Set语句和字典工具的Remove方法就能实现。
我们乃至可以在每个节点中加入 首节点 和 末节点 的链接,或则加入隔一个节点的链接,呵呵。

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

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

Function 创建关系网()

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

Dim i&, j&

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

Set dic关系网 = CreateObject(\"大众Scripting.Dictionary\"大众)

For i = 1 To Ubound(arr源数据)

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

Set dic关系网(str姓名) = CreateObject(\"大众Scripting.Dictionary\公众)

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个!
嗯,显然这一说法是不可能被证明的。
但如果真的作为一个证明题的话,那请给我天下上每个人所认识的人的清单,至少我们能够建立一个超级网状数据模型,至于如何能够找出任何两个节点间的最短路径的问题则是算法范畴啦,不在此文谈论之列。

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

行文至此,也是结束的时候了。
非常汗颜的是我是在最近一两个月才开始考试测验利用字典工具的,十分感谢浩瀚朋友,之前虽有听说,但一贯都没用过。
而居然我会写这么一个长篇来先容如何利用,现在想想都有些可笑,相信文中会有很多错漏之处,欢迎各位朋友指出。
同样的也欢迎大家能共同谈论各自的创造或履历。

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

是的,字典工具仅仅是一个工具,如果以为顺手的话,不妨多用用。
感谢阅读。

小伙伴,大家一起学习Excel VBA知识,一起进步。
同时欢迎大家帮忙转发并关注,感激大家的支持!