[分享]浅谈DICTIONARY(字典)对象

northwolves

 

[前言]

      第一次见到字典的用法是在2003年,记得是一个关于列举闰年的帖子,代码大致如下:

Sub diag()
Dim i As Integer
With CreateObject("scripting.dictionary")
For i = 2000 To 2100
If Day(DateSerial(i, 3, 0)) = 29 Then .Add i, Nothing
Next
MsgBox Join(.keys, " ")
End With
End Sub

 

   当时深感字典对象的神奇,所以把帮助看了又看,对它有了初步的了解，试着写了一些测试代码，总体感觉效率还可以。年初论坛有网友问到字典对象，曾随手写了几个应用的例子（http://club.excelhome.net/viewthread.php?tid=211734&replyID=&skin=0 ）。看到最近论坛上有许多朋友希望对字典对象做进一步的学习,特补充一些字典的常见用法，与大家分享。

 

    看山菊花版主的帖子是一种享受，可惜我没有那么高的水平，请大家谅解。

 

 

[定义]

 

      Dictionary 对象是  “ Scripting   Runtime   Library”   的一部分，最早在VBScript  中实现.（SCRRUN.DLL），它将任何形式的数据的条目被存储在数组中。每个条目都与一个唯一的关键字相关联。该关键字用来检索单个条目，通常是整数或字符串，可以是除数组外的任何类型.

 

 

northwolves

[Dictionary 对象的属性和说明]

属性	说明
CompareMode	设定或返回键的字符串比较模式（仅用于 VBScript）
Count	只读。返回 Dictionary 里的键/条目对的数量
Item(key)	设定或返回指定的键的条目值
Key(key)	设定键值

oobird

呵呵，狼兄终于决定要应这个主题开课了，恭喜所有的朋友啦，大家有福了。搬张椅子，拭目期待中。

特别一提的是

CompareMode 属性

我在帮助中真的看不懂，如何用及什么时候用？

4个常数除了最后一个指明用于access外，真的看不出用于哪里，范例没有，论场中也找不到前例，能稍作说明吗？

辛苦了！

northwolves

MSDN帮助文件内容

Key 属性

         

描述

在一个 Dictionary 对象中设置一个 key。

语法

object.Key(key) = newkey

Key 属性具有下列部分：

部分	描述
object	必需的。总是一个 Dictionary 对象的名字。
key	必需的。被更改的 Key值。
newkey	必需的。替换指定 key 的新值。

说明

如果在更改某个 key 时，没有找到 key，则会出现运行时错误。

Item 属性

         

描述

对 Dictionary 对象中指定的 Key，设置或返回一个 Item 。对于集合来说，基于指定的 Key ，返回一个 Item 。读/写属性。

语法

object.Item(key) [= newitem]

Item 属性具有下列部分：

部分	描述
object	必需的。总是一个集合或 Dictionary 对象的名称。
key	必需的。与被检索或添加的条目相关联的 Key 。
newitem	可选的。仅用于 Dictionary 对象；没有用于集合的应用程序。如果提供的话，newitem 是与指定的 Key 相关联的新值。

说明

如果在改变某个 item 时，没有找到 key，则用指定的newitem创建一个新的 key 。如果在试图返回某个已存在条目时，没有找到 key，则创建一个新 key，且其相应的条目为空。

Count 属性

         

描述

返回集合或 Dictionary 对象中的条目数。只读。

语法

object.Count

object 总是“应用于”列表中某一项的名称。

说明

下面的代码举例说明了 Count 属性的使用方法：

Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
		d.Add "a", "Athens"     '添加一些关键字和条目。
d.Add "b", "Belgrade"
		d.Add "c", "Cairo"
		a = d.Keys              '获得关键字
For i = 0 To d.Count -1 '遍及数组
    Print a(i)          '打印关键字
Next
		...
		
CompareMode 属性
         
描述
设置或返回某个 Dictionary 对象中的比较字符串关键字的比较模式。
语法
object.CompareMode[ = compare]
CompareMode 属性具有下列部分：
部分
描述
object
必需的。总是一个 Dictionary 对象的名称。
compare
可选的。如果提供的话，compare 是一个代表比较模式的值，该比较模式用于象 StrComp 这样的函数。

设置
compare 参数可以具有下列值：
常数
值
描述
VbUseCompareOption
–1
使用 Option Compare 语句的设置值进行比较。
vbBinaryCompare
 0
进行二进制比较。
vbTextCompare
 1
进行文字比较。
vbDatabaseCompare
 2
仅用于 Microsoft Access。进行基于您自己数据库中信息的比较。

说明
如果试图对已经包含数据的 Dictionary 对象的比较模式进行更改的话，就会出错。
CompareMode 属性所用的参数值与 StrComp 函数所用的 compare 参数相同。可以用大于 2 的值表示使用特定 Locale IDs (LCID) 的比较。

northwolves

[Dictionary 对象的方法和说明]

 

方法	说明
Add(key,item)	增加键/条目对到 Dictionary
Exists(key)	如果指定的键存在，返回 True，否则返回 False
Items()	返回一个包含 Dictionary 对象中所有条目的数组
Keys()	返回一个包含 Dictionary 对象中所有键的数组
Remove(key)	删除一个指定的键/条目对
RemoveAll()	删除全部键/条目对

northwolves

MSDN帮助文件内容

Add方法(Dictionary)

         

描述

添加一对相对应的关键字和条目到 Dictionary 对象。

语法

object.Add key, item

Add方法的语法有如下几部分：

部分	描述
Object	必需的。一个 Dictionary 对象的名字。
Key	必需的。与所添加的条目相关联的关键字。
Item	必需的。与所添加的关键字相关联的条目。

说明

如果该关键字已经存在，则产生一个错误。

Exists 方法

         

描述

如果在 Dictionary 对象中指定的关键字存在，返回 True，若不存在，返回 False。

语法

object.Exists(key)

Exists 方法语法有如下几部分：

部分	描述
Object	必需的。始终是一个 Dictionary 对象的名字。
Key	必需的。在 Dictionary 对象中搜索的 Key 值。

Keys方法

         

描述

返回一个数组，该数组包含一个 Dictionary 对象中的全部已有的关键字。

语法

object.Keys

object始终是一个 Dictionary 对象的名字。

说明

下面的代码举例说明了 Keys 方法的使用。

Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
		d.Add "a", "Athens"     '添加一些关键字和条目。
d.Add "b", "Belgrade"
		d.Add "c", "Cairo"
		a = d.keys              '取得关键字
For i = 0 To d.Count -1 '重复数组
    Print a(i)          '打印关键字
Next
		...

Items 方法

描述

返回一个包含 Dictionary 对象中所有条目的数组。

语法

object.Items
		

object始终是一个 Dictionary 对象的名字。

说明

下面的代码举例说明了 Items 方法的使用。:

Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
			d.Add "a", "Athens"     '添加一些关键字和条目。
d.Add "b", "Belgrade"
			d.Add "c", "Cairo"
			a = d.Items             '取得条目
For i = 0 To d.Count -1 '重复数组
    Print a(i)          '打印条目
Next
			...
		

Remove 方法

         

描述

从一个 Dictionary 对象中删除一个关键字和条目对。

语法

object.Remove(key)

Remove 方法语法有如下几部分：

部分	描述
Object	必需的。始终是一个 Dictionary 对象的名字。
Key	必需的。Key 与要从 Dictionary 对象中删除的关键字和条目对相关联。

说明

如果指定的关键字和条目对不存在，则发生一个错误。

下面的代码举例说明了 Remove 方法的使用：

Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
		d.Add "a", "Athens"     '添加一些关键字和条目
d.Add "b", "Belgrade"
		d.Add "c", "Cairo"
		...
		a = d.Remove()
		
	

RemoveAll 方法
         
描述
RemoveAll 方法从 Dictionary 对象中删除所有关键字和条目对。
语法
object.RemoveAll
		
object始终是一个 Dictionary 对象的名字。
说明
下面的代码举例说明了 RemoveAll 方法的用法：
Dim a, d, i             '创建一些变量
Set d = CreateObject("Scripting.Dictionary")
			d.Add "a", "Athens"     '添加一些关键字和条目
d.Add "b", "Belgrade"
			d.Add "c", "Cairo"
			...
			a = d.RemoveAll         '清除字典

northwolves

特别说明:

Dictionary的CompareMode属性与VBA的Comparison常数是一致的:
   

常数	值	描述
VbUseCompareOption	-1	使用Option Compare语句的设置进行比较。
VbBinaryCompare	0	进行二进制的比较。
VbTextCompare	1	进行文字的比较。
vbDatabaseCompare	2	用于 Microsoft Access(仅限于Windows)，进行以数据库所含信息为基础的比较。

区别:

Sub macro1()
Dim d As New Dictionary, s, i As Long
s = [{"aa","Aa","aA"}]
On Error Resume Next
d.CompareMode = BinaryCompare'二进制方式比较,即a,A是不同字符
For i = 1 To 3
d.Add s(i), ""
Next
Debug.Print Join(d.Keys, vbCrLf); vbCrLf; "d.Count=" & d.Count
End Sub

返回:

aa
Aa
aA
d.Count=3

Sub macro2()
Dim d As New Dictionary, s, i As Long
s = [{"aa","Aa","aA"}]
On Error Resume Next
d.CompareMode = TextCompare'文本方式比较,即a,A是相同字符
For i = 1 To 3
d.Add s(i), ""
Next
Debug.Print Join(d.Keys, vbCrLf); vbCrLf; "d.Count=" & d.Count
End Sub

返回:

aa
d.Count=1

另: 以下函数也具有此属性,应用时需要注意:

InStr 函数

返回 Variant (Long)，指定一字符串在另一字符串中最先出现的位置。

语法 InStr([start, ]string1, string2[, compare])

InStrRev函数

描述

返回一个字符串在另一个字符串中出现的位置，从字符串的末尾算起。

语法

InstrRev(stringcheck,
    stringmatch[,
    start[,
    compare]])

StrComp 函数

返回 Variant (Integer)，为字符串比较的结果。

语法

StrComp(string1, string2[, compare])

Replace函数

描述

返回一个字符串，该字符串中指定的子字符串已被替换成另一子字符串，并且替换发生的次数也是指定的。

语法

Replace(expression,
    find,
    replace[,
    start[,
    count[,
    compare]]])

Filter函数

描述

返回一个下标从零开始的数组，该数组包含基于指定筛选条件的一个字符串数组的子集。

语法

Filter(sourcesrray, match[, include[, compare]])

Split函数

描述

返回一个下标从零开始的一维数组，它包含指定数目的子字符串。

语法

Split(expression[,
    delimiter[,
    limit[,
    compare]]])

如果模块级别使用了Option Compare {Binary | Text | Database}声明,Dictionary对象与以上列举函数将默认使用此格式.

常数	值	描述
VbUseCompareOption	-1	使用Option Compare语句的设置进行比较。
VbBinaryCompare	0	进行二进制的比较。
VbTextCompare	1	进行文字的比较。
vbDatabaseCompare	2	用于 Microsoft Access(仅限于Windows)，进行以数据库所含信息为基础的比较。

区别:

Sub macro1()
Dim d As New Dictionary, s, i As Long
s = [{"aa","Aa","aA"}]
On Error Resume Next
d.CompareMode = BinaryCompare'二进制方式比较,即a,A是不同字符
For i = 1 To 3
d.Add s(i), ""
Next
Debug.Print Join(d.Keys, vbCrLf); vbCrLf; "d.Count=" & d.Count
End Sub

返回:

aa
Aa
aA
d.Count=3

Sub macro2()
Dim d As New Dictionary, s, i As Long
s = [{"aa","Aa","aA"}]
On Error Resume Next
d.CompareMode = TextCompare'文本方式比较,即a,A是相同字符
For i = 1 To 3
d.Add s(i), ""
Next
Debug.Print Join(d.Keys, vbCrLf); vbCrLf; "d.Count=" & d.Count
End Sub

返回:

aa
d.Count=1

另: 以下函数也具有此属性,应用时需要注意:

InStr 函数

返回 Variant (Long)，指定一字符串在另一字符串中最先出现的位置。

语法 InStr([start, ]string1, string2[, compare])

InStrRev函数

描述

返回一个字符串在另一个字符串中出现的位置，从字符串的末尾算起。

语法

InstrRev(stringcheck,
    stringmatch[,
    start[,
    compare]])

StrComp 函数

返回 Variant (Integer)，为字符串比较的结果。

语法

StrComp(string1, string2[, compare])

Replace函数

描述

返回一个字符串，该字符串中指定的子字符串已被替换成另一子字符串，并且替换发生的次数也是指定的。

语法

Replace(expression,
    find,
    replace[,
    start[,
    count[,
    compare]]])

Filter函数

描述

返回一个下标从零开始的数组，该数组包含基于指定筛选条件的一个字符串数组的子集。

语法

Filter(sourcesrray, match[, include[, compare]])

Split函数

描述

返回一个下标从零开始的一维数组，它包含指定数目的子字符串。

语法

Split(expression[,
    delimiter[,
    limit[,
    compare]]])

如果模块级别使用了Option Compare {Binary | Text | Database}声明,Dictionary对象与以上列举函数将默认使用此格式.

[此贴子已经被作者于2007-9-9 0:32:05编辑过]

northwolves

Dictionary属性和方法的亮点(与Collection对象相比):

1.key属性可随时更改:

If dic.Exists(OldKey) Then dic.Key(OldKey) = NewKey

2.item属性可随时更改:
If dic.Exists(OldKey) Then dic.Item(OldKey) = NewItem

3.Keys方法可得到一个下界为0的一维数组:

Dim s

s=dic.keys

4.items方法也可得到一个下界为0的一维数组:

Dim s

s=dic.Items

5. Remove 方法可直接删除Dictionary对象的某一个元素,对于VB的一维数组来说,省去了不少编码的烦恼

6. Removeall方法可直接删除Dictionary对象的全部元素

7.对于使用Keys和items方法得到的数组,可以使用VBA的数组的全部技巧进行处理,如Filter(),Join()函数及工作表函数Transpose(),Max(),Min(),Large()等的使用.

8.Count属性为Dictionary数组与EXCEL工作表的相互赋值提供了方便.

9.键值的唯一性使得Dictionary对象在统计"不重复"方面的问题得心应手,而item属性可更改更使得Dictionary对象在数据汇总上大显身手.

10.VBA的一些控件如listbox,combobox,单元格的数据有效性,自定义序列及图表的序列,xvalue属性等也与数组有一定的联系,使得Dictionary对象也有用武之地.

后面的例子将对以上所介绍的内容进行演示.

northwolves

Dictionary对象的引用:

与其他DLL一样,我们常用以下两种方法引用Dictionary对象.

方法1:

在工具-->引用菜单中,选择Scripting   Runtime   Library:
 

然后在模块中按以下方式引用:

Dim dic As New Dictionary

或者

Dim dic2 As New Scripting.Dictionary

方法2:

使用CreateObject方法,如:

Dim dic As Object

Set dic=CreateObject("scripting.dictionary")

更多数情况下,我们可以忽略变量的定义,直接使用其属性和方法,如开头的例子:

Dim i As Integer
With CreateObject("scripting.dictionary")
For i = 2000 To 2100
If Day(DateSerial(i, 3, 0)) = 29 Then .Add i, Nothing
Next
MsgBox Join(.keys, " ")
End With

northwolves

应用实例1（顺序显示1-100）：

Sub usage()
Dim dic As Object, i As Long
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 100
dic.Add i, ""
Next
MsgBox Join(dic.keys, ",")

Set dic=Nothing
End Sub

 

应用实例2（显示1-100中含3的整数）：

Sub usage2()
Dim dic As Object, i As Long
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 100
dic.Add i, ""
Next
MsgBox Join(Filter(dic.keys, "3"), vbCrLf)

Set dic=Nothing
End Sub

应用实例3（WORKSHEET中A列显示1-10000）：

Sub usage3()
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 10000
dic.Add i, ""
Next
arr = WorksheetFunction.Transpose(dic.keys)
[a1].Resize(UBound(arr), 1) = arr
Set dic = Nothing
End Sub

应用实例4 (WORKSHEET中A列显示1 - 10000，B列逆序显示):

Sub usage4()
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 10000
dic.Add i, 10001 - i
Next
arr = WorksheetFunction.Transpose(dic.keys)
[a1].Resize(UBound(arr), 1) = arr

arr = WorksheetFunction.Transpose(dic.items)
[b1].Resize(UBound(arr), 1) = arr

Set dic = Nothing
End Sub

应用实例5 (WORKSHEET中A列显示1 - 100000中被6除余1和5 的数字):

Sub usage5()
Dim dic As Object, i As Long, arr
Set dic = CreateObject("Scripting.Dictionary")
For i = 1 To 100000
dic.Add i & IIf(Abs(i Mod 6 - 3) = 2, "@", ""), ""
Next

arr = WorksheetFunction.Transpose(Filter(dic.keys, "@"))
[a1].Resize(UBound(arr), 1) = arr
[a:a].Replace "@", ""
Set dic = Nothing
End Sub

由于代码比较简单,这里不提供相应的附件,大家添加模块,一试便知.

Filter(),Join()函数的用法可参考VBA帮助文件