当前位置:文档之家› VBA字典与数组知识与实例----字典

VBA字典与数组知识与实例----字典

VBA字典与数组知识与实例----字典
VBA字典与数组知识与实例----字典

******************************************************************************

* *

* Excel精英培训数组与字典班第二课课件:字典在VBA中应用 *

* *

* ---------兰色幻想原创 (https://www.doczj.com/doc/fa1715992.html,) *

* 欢迎转截,但禁止用于商业用途 *

******************************************************************************

一、什么是字典?我们为什么要学它?

字典(Dictionary)是VBA中提供的一个类似二维数组的可以装数据的对象。为什么要把它起名叫字典?因为它

'的使用特征很类似字典。有共有两列,第一列是"字",第二列是"对字的解释"。

字典和数组很像,但有一个特征是数组不具备的,就是它可以根据存放的内容定位数据,而数组是根据“标”

来定位,如果在数组中查找某个元素是否存在,我们除了调用工作表函数外(注:调用工作表函数会拖慢速度),只能

循环的方法来实现.

看个例子吧:

Sub t1()

Dim arr

arr = Range("a2:b5")

For x = 1 To UBound(arr)

If arr(x, 1) = "C" Then

MsgBox arr(x, 2)

End If

Next x

End Sub

从上面的例子我们就可以看出数组在定位元素时的缺陷,而字典正好可以弥补,利用字典的特征,我们可以完成以下常用功能:

1 提取唯一值

2 快速查找

3 多条件汇总

二、字典在哪里?我们如果使用它?

字典对象不是EXCEL程序直接附带的,而是在"c:\windows\system32\scrrun.dll"链接库中,所以我们要想用它,要先调用它.

调用字典有两种方法,

1 引用法:

step 1 :VBE中的工具菜单--引用--浏览---在system32文件夹中找到scrrun.dll后点打开即可.

使用dim 变量 as new dictionary 声明后就可以用了

2 创建法

Set d = CreateObject("Scripting.Dictionary") '使用CreateObject创建对字典对象的引用

一向字典内装数据

数组可以一次性的从单元格中取数,而字典呢,只能通过循环来装数据,把字装在第一列,把"内容"装在第二列.

1 使用add方法装

Sub q1()

Dim dic As New Dictionary '声明的一个字典对象

Dim arr

arr = Range("a2:b5") '把单元格数据装入内存

For x = 1 To UBound(arr)

If Not dic.Exists(arr(x, 1)) Then '字典的Exists属性可以判断在一个元素字典内的第一列是否存在

dic.Add arr(x, 1), arr(x, 2) '使用add方法向字典内装. 字典.add 第一列内容,第二列内容

End If

Next x

End Sub

2 使用修改式装

Sub q2()

Dim dic As New Dictionary

Dim arr

arr = Range("a2:b5") '把单元格数据装入内存

For x = 1 To UBound(arr)

dic(arr(x, 1)) = arr(x, 2) '如果arr(x,1)在字典中存在,则使用本次item的值替换原来的第二列值,如果不存在,则会创新一个新的key

Next x

End Sub

二取字典内的详细信息

我们装入字典的目的是为了运算和数据处理,所以装入后我们还要从字典中返回相应的数据和信息

Sub q3()

Dim dic As New Dictionary

Dim arr, arr1

arr = Range("a2:b5") '把单元格数据装入内存

For x = 1 To UBound(arr)

dic(arr(x, 1)) = arr(x, 2) '如果arr(x,1)在字典中存在,则使用本次item的值替换原来的第二列值,如果不存在,则会创新一个新的key

Next x

MsgBox dic.Count '使用count属性可以返回字典内有多少行

MsgBox dic.Item("B") '或dic("B") ,可以根据第一列的内容直接返回对应的第二列的值,这个VBA数组只能用循环完成

arr1 = dic.Keys '把字典内的第一列值一次性的放入arr1中,构成一个一维数组

MsgBox arr1(0)

Range("d1").Resize(dic.Count) = Application.Transpose(dic.Items) '通过转换把字典的第二列放入单元格中

End Sub

三清除字典的元素

Sub q4()

Dim dic As New Dictionary

Dim arr

arr = Range("a2:b5") '把单元格数据装入内存

For x = 1 To UBound(arr)

dic(arr(x, 1)) = arr(x, 2) '如果arr(x,1)在字典中存在,则使用本次item的值替换原来的第二列值,如果不存在,则会创新一个新的key

Next x

dic.Remove ("B") '使用remove 可以清除字典内指定的字符,这也是数组做不到的

MsgBox dic.Item("B")

dic.RemoveAll '清空字典

End Sub

Sub w1()

Dim arr

Dim d As New Dictionary

https://www.doczj.com/doc/fa1715992.html,pareMode = TextCompare 'CompareMode属性的值为TextCompare时,可以忽略大小写,默认大小写是不同的

arr = Range("a1:a12")

For x = 1 To UBound(arr)

If Not d.Exists(arr(x, 1)) Then

d.Add arr(x, 1), ""

End If

Next x

Range("c1").Resize(d.Count) = Application.Transpose(d.Keys)

End Sub

下面和数组比试一下速度

Sub w2() '使用字典的耗时是0.04s

t = Timer

Dim arr

Dim d As New Dictionary

arr = Range("a1:a20000")

For x = 1 To UBound(arr)

If Not d.Exists(arr(x, 1)) Then

d.Add arr(x, 1), ""

End If

Next x

Range("c1").Resize(d.Count) = Application.Transpose(d.Keys)

MsgBox Timer - t

End Sub

使用数组

Sub w3() '使用数组的耗时是10s,是字典的250倍

t = Timer

Dim arr, arr1()

arr = Range("a1:a20000")

ReDim arr1(1 To 1)

For x = 1 To UBound(arr)

For y = 1 To UBound(arr1)

If arr(x, 1) = arr1(y) Then

GoTo 100

End If

Next y

k = k + 1

ReDim Preserve arr1(1 To k)

arr1(k) = arr(x, 1)

100:00:00

Next x

Range("d1").Resize(k) = Application.Transpose(arr1)

MsgBox Timer - t

End Sub

1 双向查找

Sub e1()

Dim arr

Dim d As New Dictionary

arr = Range("a1:b6")

For x = 1 To UBound(arr) '把城市放入第一列,简写放入第二列

d(arr(x, 1)) = arr(x, 2)

Next x

For x = 1 To UBound(arr) '为了能达到双向查找,把简写放入第一列,把城市放入第二列 d(arr(x, 2)) = arr(x, 1)

Next x

MsgBox d("上海")

MsgBox d("sh")

End Sub

2 多条件查找

Sub e2()

Dim arr, arr1, arr2(1 To 2, 1 To 2), arr3

Dim d As New Dictionary

arr = Range("a2:d5")

arr1 = Range("a12:b13")

For x = 1 To UBound(arr)

d(arr(x, 1) & "-" & arr(x, 2)) = arr(x, 3) & "-" & arr(x, 4) '把字符进行合并放在字典中

Next x

For y = 1 To UBound(arr1)

arr3 = Split(d(arr1(y, 1) & "-" & arr1(y, 2)), "-") '拆分字符

arr2(y, 1) = arr3(0)

arr2(y, 2) = arr3(1)

Next y

Range("C12").Resize(2, 2) = arr2

End Sub

单条件求和

Sub p1()

Dim d As New Dictionary

Dim arr

arr = Range("b2:c5")

For x = 1 To UBound(arr)

d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2) '字典中的相同的key进行累加

Next x

Range("e2").Resize(d.Count) = Application.Transpose(d.Keys)

Range("f2").Resize(d.Count) = Application.Transpose(d.Items)

End Sub

多条件求和

Sub e2()

Dim arr, arr1, arr2(1 To 1000, 1 To 2), arr3

Dim d As New Dictionary

arr = Range("a2:c6")

For x = 1 To UBound(arr)

d(arr(x, 1) & "-" & arr(x, 2)) = d(arr(x, 1) & "-" & arr(x, 2)) + arr(x, 3) '把需要汇总的列进行连接 Next x

arr1 = d.Keys

For y = 0 To UBound(arr1)

arr3 = Split(arr1(y), "-") '把连接的产品和型号列进行拆分

arr2(y + 1, 1) = arr3(0) '拆分后的放进arr2数组中

arr2(y + 1, 2) = arr3(1)

Next y

Range("f2").Resize(d.Count, 2) = arr2

Range("h2").Resize(d.Count) = Application.Transpose(d.Items)

End Sub

多列求和

Sub e3()

Dim arr

Dim d1 As New Dictionary, d2 As New Dictionary, d3 As New Dictionary

arr = Range("a2:d6")

For x = 1 To UBound(arr)

d1(arr(x, 1)) = d1(arr(x, 1)) + arr(x, 2) '利用d1字典汇总数量

d2(arr(x, 1)) = arr(x, 3) '利用d2字典放单价,不汇总

d3(arr(x, 1)) = d3(arr(x, 1)) + arr(x, 4) '利用d3字典汇总金额

Next x

Range("a13").Resize(d1.Count) = Application.Transpose(d1.Keys) Range("b13").Resize(d1.Count) = Application.Transpose(d1.Items) Range("c13").Resize(d1.Count) = Application.Transpose(d2.Items) Range("d13").Resize(d1.Count) = Application.Transpose(d3.Items) End Sub

相关主题
相关文档 最新文档