68手游网

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 属性具有下列单元：

请注意 如果在改变某个 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 属性具有下列单元：

设定 compare 引数可以具有下列值：

请注意 如果试图对已经包含资料的 Dictionary 物件(字典)的比较模式进行更改的话，就会出错。

CompareMode 属性所用的引数与 StrComp 函数所用的 compare 引数相同。可以用大于 2 的表示使用指定的 Locale IDs (LCID) 的比较。

dictionary方法：

1、Add 方法 (目录)

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

语法：object.Add key, item

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

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

2、Exists 方法

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

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

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 方法语法有如下几个单元：

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

下面的程式码举例說明了 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