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

来源:互联网 时间:2016-01-03

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 。对于集合?碚f,基于指定的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方法的语法有如下几个单元:

?卧?/font>

描述

Object

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

Key

必要引数。与所加入的项目相关的关键字。

Item

必要引数。与所加入的关键字相关的项目。

请注意 如果关键字已经存在,?t产生一个错误。

2、Exists 方法

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

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

?卧?/font>

描述

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

?卧?/font>

描述

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

Top