Excel中DICTIONARY(字典)对象使用基础教程

时间:2012-06-17 02:08来源:Office教程学习网 www.office68.com编辑:麦田守望者

1. Dictionary 物件(字典)

描述: 物件(字典)，用于储存資料关键字和項目对。

语法: Scripting.Dictionary

请注意

Dictionary 物件(字典)与 PERL 相关阵列全等。可以是任何型式的資料的项目被储存在阵列中。每个项目都与一个唯一的关键字相关。該关鍵字用来取出单个项目，通常是整数或字串，可以是除阵列外的任何型态。

下面的程序码举例說明了如何建立一个 Dictionary 物件(字典)：

Dim d '建立一个变数

Set d = CreateObject(Scripting.Dictionary)

d.Add "a", "Athens" '加入一些关键字和项目

d.Add "b", "Belgrade"d.Add "c", "Cairo"

2. Key 属性

描述: 在一个 Dictionary 物件中设定一个 key。

语法: object.Key(key) = newkeyKey

属性具有下列单元：

单元 描 述

object 必要引数。始終是一个 Dictionary 物件(字典)的名字。

key 必要引数。被更改的 Key。

newkey 必要引数。取代指定 key 的新。

请注意 如果在更改某个 key 时，沒有找到 key，则会出现执行阶段错误。

3. 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，且其相对的项目为无。

4. 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

...

5. 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) 的比较。

dictionary方法：

1、Add 方法 (目录)

描述：加入一对相对应的关键字和項目到 Dictionary 物件(字典)。

语法：object.Add key, item

Add方法的语法有如下几个单元：

單元	描述
Object	必要引数。一个 Dictionary 物件(字典)的名字。
Key	必要引数。与所加入的项目相关的关键字。
Item	必要引数。与所加入的关键字相关的项目。

请注意 如果关键字已经存在，則产生一个错误。

2、Exists 方法

描述: 如果在 Dictionary 物件(字典)中指定字存在，传回 True，若不存在，传回 False。

语法: object.Exists(key) Exists 方法语法有如下几个单元：

單元	描述
Object	必要引数。始终是一个 Dictionary 物件(字典)的名字。
Key	必要引数。在 Dictionary 物件(字典)中搜寻的 Key 值。

3、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

...

4、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

5、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()

6、RemoveAll 方法

描述：RemoveAll 方法从 Dictionary 物件(字典)中移除所有关键字和项目对。

语法：object.RemoveAllobject始终是一个 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

Dictinary.keys返回一维数组，因而应用比较广泛

应用实例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

应用实例6 （跨表不重复值提取）:

Sub Usage6()

Application.ScreenUpdating = False ’停止屏幕刷新(也能提高程序运行速度)

Dim r As Range, arr

Worksheets("All").Select

With CreateObject("scripting.dictionary")

For Each r In Range("D3:D" & Range("A65536").End(xlUp).Row)

If Not .exists(r.Value) Then .Add r.Value, Nothing

Next

Worksheets("temp").Select

Cells.Clear

Range("a2").Resize(.Count, 1) = WorksheetFunction.Transpose(.keys)

End With

Application.ScreenUpdating = True ’重启屏幕刷新

End Sub

应用实例7 (COMBOBOX赋值):

Private Sub UserForm_Initialize()

Dim dic As Object, i As Long, arr

Set dic = CreateObject("Scripting.Dictionary")

For i = 1 To 1000

dic.Add i, ""

Next

UserForm1.ComboBox1.List = dic.keys

Set dic = Nothing

End Sub

应用实例8 本例统计某字符串中各字符出现的频率并显示在WORKSHEET的前两行

Sub Usage8_2()

Const s As String = "在VBA中有一个数据字典即dictionary功能很好，运行速度比较快，掌握以后可以替代一些其他查找功能，现向老师请教数据字典即dictionary的基本原理是怎样的，它适合于哪些情况之下可以运用，在运用过程中应当注意哪些问题。"

Dim i As Long, temp As String, dic As Object

Set dic = CreateObject("scripting.dictionary")

For i = 1 To Len(s)

temp = Mid(s, i, 1)

If Not dic.exists(temp) Then

dic.Add temp, 1

Else

dic(temp) = dic(temp) + 1

End If

Next

[a1:a2] = WorksheetFunction.Transpose(Array("字符", "出现次数"))

[b1].Resize(1, dic.Count) = dic.keys

[b2].Resize(1, dic.Count) = dic.items

Set dic = Nothing

End Sub

应用实例9 列出一个工作簿中所有已使用的自定义函数（需要添加对VB项目的信任）

Sub UDFSOFACTIVEWORKBOOK()

Dim sh As Worksheet, r As Range, dic As Object, i As Long, temp As String, VBcomp, s() As String, UDF As String

For i = 1 To ActiveWorkbook.VBProject.VBComponents.Count

Set VBcomp = ActiveWorkbook.VBProject.VBComponents(i)

If VBcomp.Type = 1 Then temp = temp & VBCrLf & VBcomp.CodeModule.Lines(1, 65536)

Next

s = Split(temp, VBCrLf)

temp = ""

For i = 0 To UBound(s)

If s(i) Like "Function * As *" Then temp = temp & "@" & "=" & Trim(Split(Split(s(i), "(")(0), "Function")(1)) & "(" '--->All functions with or without parameters

Next

Set dic = CreateObject("scripting.dictionary")

For Each sh In Sheets

For Each r In sh.UsedRange

If r.HasFormula Then

If InStr(temp, "@" & Split(r.Formula, "(")(0)) > 0 Then

UDF = r.Formula & "udf"

Else

UDF = ""

End If

If Not dic.exists(r.Formula) Then dic.Add r.Formula, UDF

End If

Next

Next

Debug.Print "All functions used in activesheet" & VBCrLf & String(50, "-") & VBCrLf & Join(dic.keys, VBCrLf) & VBCrLf & VBCrLf '列出一个工作簿中所有函数

Debug.Print "All user define functions used in activesheet" & VBCrLf & String(50, "-") & VBCrLf & Replace(Join(Filter(dic.items, "udf"), VBCrLf), "udf", "") '列出一个工作簿中所有已使用的自定义函数

Set dic = Nothing

End Sub

应用实例10 列出Word 文档中所用的全部字体集合(在WORD VBA中使用)

Sub Usage10()

Dim myRange As Range, str_Result As String, str_Temp

With CreateObject("scripting.dictionary")

On Error Resume Next

For Each str_Temp In Application.FontNames

Set myRange = ActiveDocument.Content

With myRange.Find

.ClearFormatting

.Font.NameFarEast = str_Temp

If .Font.NameFarEast <> "" Then

If .Execute(findtext:="*", MatchWildcards:=True, Wrap:=wdFindStop, Format:=True) Then

.AddComment str_Temp, ""

End If

End If

End With

Next

MsgBox Join(.keys, vbCrLf)

End With

End Sub