丽水市网站建设_网站建设公司_PHP_seo优化

目录

第6章：VBA与字典技术

1、字典技术的魅力

2、字典语法基础

3、字典实例(第1次与最后一次采购价提取)

4、字典实例（多表求不重复值）

5、字典实例(字典与数组经典结合)

6、字典实例(分类计算)

7、字典应用（多列合并计算）

在掌握了数组带来的“速度革命”之后，你是否曾为这样的问题感到棘手：如何从海量数据中瞬间找出唯一值？如何根据一个关键字快速匹配并汇总对应的信息？当面对多列数据的复杂关联时，仅靠数组的索引似乎力不从心。

本章，我们将解锁VBA中另一个堪称“神器”的核心对象——字典（Dictionary）。它不像数组那样按序号排列，而是构建了一种独特的“键-值”映射关系。正是这种结构，让它天生成为解决数据去重、分类统计、快速查询等难题的“王牌工具”。

简单来说，如果说数组是效率超高的流水线，那么字典就是一张智能的索引地图。无论是要提取客户的末次交易价格，还是合并来自多个表格且不重复的数据，字典都能用极其简洁优雅的代码，轻松实现以往需要复杂循环才能完成的任务。

让我们一起深入探究字典的六大核心方法，学习前期与后期绑定的技巧，并通过“提取首次/末次记录”、“多表合并去重”等经典案例，掌握这把提升数据处理维度与效率的利剑。

第6章：VBA与字典技术

1、字典技术的魅力

字典技术：

1、VBA中的字典（dictionary）,是微软windows脚本语言中的一个很有用的对象

2、VBA字典特点：

KEY的唯一性

KEY与Item的相互对应关系

3、字典有什么用：

字典+数组=更强大

4、字典并不存在于VBA中，需要调用：

调用方法一：引用法（前期绑定）：工具-引用-浏览-找到scrrun.dll-确定（在system32中）

引用对象为：Microsoft Scripting Runtime（此插件打上勾即引用成功）

调用方法二：直接创建法（后期绑定）：

set d=Createobject("scripting.dictionary")

建议写代码时做前期绑定，写完后改成后期绑定

理由：引用法，写代码时有提示；直接创建法在任何一台电脑中都能直接打开使用

Add方法：向dictionary对象中添加一个关键字项目对

语法：object.add(key,item)

object，必选项，是一个字典对象的名称

key，必选项，与被添加的item相关联的key

item，必选项，与被添加的key相关联的item

说明：key是唯一的，否则将导致一个错误

2、字典语法基础

Sub字典测试()

DimdAsNewDictionary

'Set d = CreateObject("scripting.dictionary")

d.Add "张三", "123"

d.Add "李四", "456"

'Keys方法：返回一个数组，其中包含了一个dictionary对象中全部的关键字

i = d.Keys(1)'前期绑定写法。 方法1

j = Application.Index(d.Keys, 2)'方法2

k = d.Keys

l = k(1)'方法3

'以上都是获取keys的第2个值

'items方法：返回一个数组，其中包含了一个dictionary对象中的所有项目

r = d.Items(1)'前期绑定写法。 方法1

s = Application.Index(d.Items, 2)'方法2

t = d("李四")'方法3

w = d.Items

v = w(1)'方法4

'Exists方法：如果dictionary对象中存在所指的关键字则返回true，否则返回false

a = d.Exists("李四")

'remove方法：从一个dictionary对象中清除一个关键字、项目对

d.Remove ("李四")

'removeall方法：从一个dictionary对象中清除所有关键字、项目对

d.RemoveAll

EndSub

'字典对象的方法有6个：

'Add添加一条关键字与条目

'keys返回所有关键字（形成1维数组）

'items返回所有条目（形成1维数组）

'exists关键字是否存在（true/false）

'remove移除关键字与对应的条目

'removeall 移除所有关键字与对应的条目

'字典对象的属性有4个：comparemode属性、count属性、key属性、item属性

Sub字典测试2()

Setd = CreateObject("scripting.dictionary")

'1、comparemode属性:设置或返回dictionary对象中字符串关键字的比较模式：

'1不区分大小写，0 区分大小写

d.CompareMode = 1

d.Add "张三", "123"

d.Add "李四", "456"

d.Add "王五", "789"

'2、count属性：返回dictionary对象中项目数。只读属性

k = d.Count

'3、key属性：在dictionary对象中修改一个key

d.Key("王五") = "孙悟空"

'4、item属性：在dictionary对象中设置或返回所指定key的item

d.Item("张三") = "88888"

d("张三") = 999'简写

'注意：容易混淆知识点：d.key("a") 与 d.item("a")

EndSub

Sub有相同key时跳过()

DimdAsNewDictionary

OnErrorResumeNext'相同key时要么跳过，要么报错

arr = Range("a2:b" & Cells(Rows.Count, 2).End(xlUp).Row)

Fori = 1ToUBound(arr)

d.Add arr(i, 1), arr(i, 2)

Next

i = d.Keys

j = d.Items

'小结：如果有错误后继续执行，只记入第一次写入的key和item

EndSub

Sub修改item值时无相同key则添加否则就修改()

DimdAsNewDictionary

arr = Range("a2:b" & Cells(Rows.Count, 2).End(xlUp).Row)

Fori = 1ToUBound(arr)

j = arr(i, 1)

m = arr(i, 2)

d.Item(j) = m'要修改的关键字（key）没有，就增加到字典中

k = d.Item("牛二")

Next

EndSub

'总结：对字典item值的修改，有key则修改，无key则添加

'这两个特点作用非常大，可以求不重复值，可以做分类汇总

3、字典实例(第1次与最后一次采购价提取)

'实例一：求每种产品第一次采购价

Sub求第一次采购价()

OnErrorResumeNext

Setd = CreateObject("scripting.dictionary")

arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)

Fori = 1ToUBound(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)

ForEachiInd.Keys'd.Keys和d.Items都是一维数组，直接一个个取出来就是原原本本的数据了

MsgBox i

Next

EndSub

'实例二：求每种产品最后一次采购价

Sub求最后一次采购价()

Setd = CreateObject("scripting.dictionary")

arr = Range("b1:c" & Cells(Rows.Count, 3).End(xlUp).Row)

Fori = 1ToUBound(arr)

d.Item(arr(i, 1)) = arr(i, 2)

Next

[i1].Resize(d.Count) = Application.Transpose(d.Keys)

[j1].Resize(d.Count) = Application.Transpose(d.Items)

EndSub

4、字典实例（多表求不重复值）

'实例：多表求不重复值

Sub多表求不重复值()

Setd = CreateObject("scripting.dictionary")

ForEachShInSheets

c = Sh.Name

Ifc <> "品名"Then

arr = Sh.Range("a1:a" & Sh.Cells(Rows.Count, 1).End(xlUp).Row)

ForEachrngInarr

d(rng) = ""'简写，相当于d.item(rng)=""

Next

EndIf

Next

[a1].Resize(d.Count) = Application.Transpose(d.Keys)

EndSub

5、字典实例(字典与数组经典结合)

'实例:字典与数组的经典结合去除重复词语

Sub去除重复词语()

Setd = CreateObject("Scripting.Dictionary")

arr = Sheet1.Range("a1:a" & Sheet1.Cells(Rows.Count, 1).End(xlUp).Row)

ForEachrngInarr

arr1 = VBA.Split(rng, "|")

ForEachrngsInarr1

d(rngs) = ""'相当于d.item(rngs)=""

Next

i = VBA.Join(d.Keys, "|")

n = n + 1

Sheet2.Cells(n, "a") = i

d.RemoveAll

Next

EndSub

6、字典实例(分类计算)

Sub分类计算()

Setd = CreateObject("scripting.dictionary")

arr = Range("n2:n" & Cells(Rows.Count, "n").End(xlUp).Row)

ForEachrngInarr

i = d(rng)'用于观察d(rng) 的值

d(rng) = d(rng) + 1'd(rng)是d.item(rng)的简写

i = d(rng)'用于观察d(rng) 的值

Next

[s2].Resize(d.Count) = Application.Transpose(d.Keys)

[t2].Resize(d.Count) = Application.Transpose(d.Items)

EndSub

Sub分类求和()

Setd = CreateObject("scripting.dictionary")

arr = Range("n2:o" & Cells(Rows.Count, "o").End(xlUp).Row)

Fori = 1ToUBound(arr)

d(arr(i, 1)) = d(arr(i, 1)) + arr(i, 2)

'd(arr(i, 1))相当于d.item(arr(i, 1)),它取得的是相应key的item值

Next

[s9].Resize(d.Count) = Application.Transpose(d.Keys)

[t9].Resize(d.Count) = Application.Transpose(d.Items)

EndSub

7、字典应用（多列合并计算）

Sub多列合并计算()

Setd = CreateObject("scripting.dictionary")

arr = Range("a2:d" & Cells(Rows.Count, "d").End(xlUp).Row)

Fork = 7To9

Fori = 1ToUBound(arr)

d(arr(i, 1)) = d(arr(i, 1)) + arr(i, k - 5)

​​​​​​​Next

Cells(2, 6).Resize(d.Count) = Application.Transpose(d.Keys)

Cells(2, k).Resize(d.Count) = Application.Transpose(d.Items)

d.RemoveAll

Next

EndSub

Sub字典条目数组用法()

Setd = CreateObject("scripting.dictionary")

arr = Sheets("data").Range("a2:e" & Sheets("data").Cells(Rows.Count, 1).End(xlUp).Row)

Fori = 1ToUBound(arr)

d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3), arr(i, 4), arr(i, 5))'把2到5列的信息放到d.item(arr(i, 1))中

j = d(arr(i, 1))'用于在“本地窗口”查看字典条目的变化

Next

ForEachrngInRange("a3:a" & Cells(Rows.Count, 1).End(xlUp).Row)

rng.Offset(0, 1).Resize(1, 4) = d(rng.Value)'d(rng.Value)是d.item(rng.Value)的简写

Next

EndSub

计算机科学与技术 & 计算机网络技术：双专业课程体系完全导航指南​​​​​​​