|
'''------字典Dictionary 是微软Windows脚本语言中的一个很有用的对象
'字典的特点 :
'key 唯一 好比每个字
'key 与 item相互对应关系 Item 解释
''字典不是VBA自带的 需要调用
''调用方法1 :引用法(前期绑定) 工具-引用-浏览-找到scrrun.dll-确定
''调用方法2: 直接创建（后期绑定） set d=createobject("scripting.dictionary ")
Sub TTTDictionary1() ''前期绑定 申明
Dim s As New Dictionary
End Sub
Sub TTTDictionary2() ''后期绑定
Set d = CreateObject("scripting.dictionary ")
End Sub
''add 方法
'object.add(key,item) key 唯一
Sub TDictionaryadd()
Dim s As New Dictionary
s.Add "张三", "123"
s.Add "李四", "456"
''keys 方法 返回一个数组 其中包含一个 Dictionary 对象中的全部现有关键字
i = s.Keys(0) ''前期绑定写法 返回字典排位第一的
'j = Application.Index(s.Keys, 1) ''后期绑定 方法2
k = s.Keys ''赋值 变成了数组
kk = k(0) ''取数组的值
''Items 方法 返回一个数组 其中包含一个 Dictionary 对象中所有项目
r = s.Items(0) ''前期绑定写法 返回字典的第一个对应的解释I
'l = Application.Index(s.Items, 1) '方法2
t = s("张三") '方法3
w = s.Items
v = w(1)
End Sub
''字典对象的属性有4个,compareMode 属性 count 属性 key属性 Item 属性
Sub 字典属性()
'Set d = CreateObject("scripting.dictionary")
Dim d As New Dictionary
'CompareMode 属性 区分大小写
d.CompareMode = 0 '1则不区分大小写 0则区分大小写
d.Add "a", ""
d.Add "A", ""
d.Add "张三", "135555555"
d.Add "李四", "1356666666"
'2 count 属性 统计
k = d.Count ''统计项目数
'3 key 属性 修改一个 key
d.Key("张三") = "刘五"
'4.Item 属性
i = d.Items ''条目明细
d.Item("刘五") = "123" ''修改条目
i = d.Items
d("刘五") = "456" '简写
i = d.Items
End Sub
Sub 数组写入字典()
Dim d As New Dictionary
On Error Resume Next ''错误继续执行 如果有重复会跳过
arr = Range("a1:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
d.Add arr(i, 1), arr(i, 2)
Next
i = d.Keys
j = d.Items
End Sub
Sub 数组写入字典2()
Dim d As New Dictionary
On Error Resume Next ''错误继续执行 如果有重复会跳过
arr = Range("a1:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
j = arr(i, 1)
m = arr(i, 2)
d.Item(arr(i, 1)) = arr(i, 2) ''修改解释 要修改的关键字没有 就添加到字典中去
k = d.Item("张三")
Next
i = d.Keys
j = d.Items
End Sub
'总结 对于字典Item 值得修改 1 . 有key 则修改, 无key 则添加
Sub 多表不重复值汇总()
Dim d As New Dictionary
For Each sh In Sheets
If sh.Name <> "Sheet1" Then
arr = sh.Range("a1:a" & sh.Cells(Rows.Count, 1).End(xlUp).Row)
For Each rng In arr
d.Item(rng) = "" ''修改解释 要修改的关键字没有 就添加到字典中去
Next
End If
Next
[a1].Resize(d.Count) = Application.Transpose(d.Keys)
End Sub
'''实例：求每种产品第一次采购单价
Sub first()
Dim arr()
On Error Resume Next
Set d = CreateObject("scripting.dictionary")
arr = Range("a1:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
d.Add arr(i, 1), arr(i, 2) '' 添加 如果存在就会跳过继续执行
Next
[e1].Resize(d.Count) = Application.Transpose(d.Keys)
[f1].Resize(d.Count) = Application.Transpose(d.Items)
End Sub
Sub last()
Dim arr()
On Error Resume Next
Set d = CreateObject("scripting.dictionary")
arr = Range("a1:b" & Cells(Rows.Count, 2).End(xlUp).Row)
For i = 1 To UBound(arr)
d.Item(arr(i, 1)) = arr(i, 2)
Next
[h1].Resize(d.Count) = Application.Transpose(d.Keys)
[i1].Resize(d.Count) = Application.Transpose(d.Items)
End Sub
|
