Excel VBA字典

Option Explicit
'1 什么是VBA字典？
'字典（dictionary）是一个储存数据的小仓库。

共有两列。

'第一列叫key , 不允许有重复的元素。

'第二列是item,每一个key对应一个item，本列允许为重复
'Key item
'A 10
'B 20
'C 30
'Z 10
'2 即然有数组，为什么还要学字典？
'原因:提速，具体表现在
'1) A列只能装入非重复的元素，利用这个特点可以很方便的提取不重复的值
'2) 每一个key对应一个唯一的item，只要指点key的值，就可以马上返回其对应的item，利用字典可以实现快速的查找
'3 字典有什么局限？
'字典只有两列，如果要处理多列的数据，还需要通过字符串的组合和拆分来实现。

'字典调用会耗费一定时间，如果是数据量不大，字典的优势就无法体现出来。

'4 字典在哪里？如何创建字典？
'字典是由scrrun.dll链接库提供的，要调用字典有两种方法
'第一种方法：直接创建法
'Set d = CreateObject("scripting.dictionary")
'第二种方法：引用法
'工具-引用-浏览-找到scrrun.dll-确定
Option Explicit
'1 装入数据
Sub t1()
Dim D As New Dictionary
Dim x As Integer
For x = 2 To 4
D.Add Cells(x, 1).Value, Cells(x, 2).Value
Next x
MsgBox D.Keys(0)
MsgBox D.Keys(1)
MsgBox D.Keys(2)
MsgBox D.Items(0)
'Stop
End Sub
'2 读取数据
Sub t2()
' Dim D
Dim D As New Dictionary
Dim arr
Dim x As Integer
' Set D = CreateObject("scripting.dictionary")
For x = 2 To 4
D.Add Cells(x, 1).Value, Cells(x, 2).Value
Next x
MsgBox D("李四")
MsgBox D.Keys(2)
Range("d1").Resize(D.Count) = Application.Transpose(D.Keys)
Range("e1").Resize(D.Count) = Application.Transpose(D.Items)
arr = D.Items
End Sub
'3 修改数据
Sub t3()
Dim D As New Dictionary
Dim x As Integer
For x = 2 To 4
D.Add Cells(x, 1).Value, Cells(x, 2).Value
Next x
D("李四") = 78
MsgBox D("李四")
D("赵六") = 100
MsgBox D("赵六")
End Sub
'4 删除数据
Sub t4()
Dim D As New Dictionary
Dim x As Integer
For x = 2 To 4
D(Cells(x, 1).Value) = Cells(x, 2).Value
Next x
D.Remove "李四"
' MsgBox d.Exists("李四")
D.RemoveAll
MsgBox D.Count
End Sub
'区分大小写
Dim D As New Dictionary
Dim x
For x = 1 To 5
D(Cells(x, 1).Value) = ""
Next x
Stop
End Sub
ub 求和问题()
Dim arr, D As Object, ar
Dim i As Integer, j As Byte
Set D = CreateObject("scripting.dictionary")
arr = Sheet2.Range("a1").CurrentRegion '选定区域装入数组
Dim t$
For i = 1 To UBound(arr) '循环从数组第1行到数组的最后一行
t = arr(i, 1) & "|" & arr(i, 2)
If D.Exists(t) Then
D(t) = t & "|" & (--Split(D(t), "|")(2) + arr(i, 3)) '如果有相应的key,则提取对应item的的销售额与现有的相加，再组合后存入字典
Else
D(t) = t & "|" & arr(i, 3) '如果没有相应的Key，则存入"日期｜名称｜销售额"
End If
Next i
ReDim arr(1 To D.Count, 1 To 3)
ar = D.Items
For i = 1 To UBound(ar) + 1
For j = 1 To 3
arr(i, j) = Split(ar(i - 1), "|")(j - 1)
Next j
Next i
Sheet3.Range("a1").CurrentRegion.ClearContents
Sheet3.Range("a1").Resize(UBound(arr), 3) = arr
End Sub
Option Explicit
Sub 多表双向查找()
Dim d As New Dictionary
Dim x, y
Dim arr
For x = 3 To 5
arr = Sheets(x).Range("a2").Resize(Sheets(x).Range("a65536").End(xlUp).Row - 1, 2) For y = 1 To UBound(arr)
d(arr(y, 1)) = arr(y, 2)
d(arr(y, 2)) = arr(y, 1)
Next y
Next x
MsgBox d("C1")
MsgBox d("吴情")
End Sub
Option Explicit
Sub 汇总()
Dim d As New Dictionary
Dim arr, x
arr = Range("a2:b10")
For x = 1 To UBound(arr)
d(arr(x, 1)) = d(arr(x, 1)) + arr(x, 2) 'key对应的item的值在原来的基础上加新的Next x
Range("d2").Resize(d.Count) = Application.Transpose(d.Keys)
Range("e2").Resize(d.Count) = Application.Transpose(d.Items)
End Sub
Option Explicit
Sub 提取不重复的产品()
Dim d As New Dictionary
Dim arr, x
arr = Range("a2:a12")
For x = 1 To UBound(arr)
d(arr(x, 1)) = ""
Next x
Range("c2").Resize(d.Count) = Application.Transpose(d.Keys)
End Sub。