字典方面的基础学习

字典方面的基础学习

字典方面的基础学习，谢谢各位帮忙

ccc

想取得arr的不重复值显示在第1行，请帮忙修改代码，谢谢

option base 1

Sub ccc()

Dim d, arr, i%

Set d = CreateObject("Scripting.Dictionary")

arr = Array(1, 1, 1, 2, 3, 44, 4, 44, 4, 5)

For i = 1 To UBound(arr)

If Not d.exists(arr(i)) Then

d.Add arr(i)

End If

Next

Sheet1.[a1].Resize(d.Count, 1) = d.keys

End Sub

呵呵，虚心学习是好事。

代码有两处错误。

1. 词典赋值语句：

d.Add arr(i) 错误，缺了Item值

应该改为：

d.Add arr(i), ""

语法：d.Add 关键词,内容

此处内容不可缺。

或者直接使用：

d(arr(i)) = ""

语法: d(关键词)=内容

……

顺便说，d(arr(i)) = ""

这种方式有个好处，不用事先判断该关键词是否已经存在，就可执行。即，

如果关键词已经存在，则修改关键词相关内容，

如果关键词不存在，则把关键词加入词典并同时加入相关内容。

因此，代码可省略是否存在的判断而简化为：

For i = 1 To UBound(arr)

d(arr(i)) = ""

第二处错误，是结果输出问题。

d.keys结果，是个一维列数组，可以直接输出到整行，

但你的代码写错了：

[a1].Resize(d.Count,1) = d.keys

这个是多行单列范围输出。

应该改为：

[a1].Resize(, d.Count) = d.keys

这个，才是单行多列输出。

如果需要多行单列输出，那就要使用transpose函数了：

[a1].Resize(d.Count, 1) = WorksheetFunction.Transpose(d.keys)

第一次看到此种写法谢谢啊受益匪浅

第2个错误是Resize(d.Count, 1)应该改为Resize(1，d.Count) 已调试成功谢谢

继续学习字典继续提问高手们。谢谢

如果字典的关键字对应很多items怎么办，比如

姓名地址性别年龄姓名地址性别年龄

a a街男22 d

b b街女23 c

c c街男23 b

d d街女24 a

e e街男26 e

自己写了个程序可以将右边的地址取出来（姓名是关键字），但是如果要将右边的表都查找到，是不是要换三次items，还是有什么更好的方法吗？请各位高手不吝赐教，谢谢Option Base 1

Sub a()

Dim i%, d, arr, brr

Set d = CreateObject("Scripting.Dictionary")

arr = Range("a2:d" & [a65530].End(3).Row).Value

brr = Range("g2:g" & [g65530].End(3).Row).Value

Application.ScreenUpdating = False

For i = 1 To UBound(arr) '地址

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

Next

For i = 1 To UBound(arr)

brr(i, 1) = d.Item(brr(i, 1))

Next

[h2].Resize(d.Count, 1) = brr

Application.ScreenUpdating = True

Set d = Nothing

End Sub 此程序只能取出右表的地址

把关键词（姓名）以外的相对应的信息，一起合并压入到Item中就可以了。

为了今后能逐项取出，信息合并压入时要指定分隔符。

取出时即可用split还原。

00.00.Sub d_test()

00.

00. arr = [a1].CurrentRegion '获取原始数据压入数组arr （用当前区域较为智能）

00. brr = [g1].CurrentRegion '获取操作要求数据压入数组brr

00.

00. Set d = CreateObject("Scripting.Dictionary") '定义字典。这个不能省略。

00.

00. For i = 2 To UBound(arr) '遍历原始数据（从第2行开始）

00. d(arr(i, 1)) = arr(i, 2) & ";" & arr(i, 3) & ";" & arr(i, 4) '对每个关键词压入合并信息，以";"分隔。

00. Next

00.

00. For i = 2 To UBound(brr) '遍历查询要求数组brr

00. t = Split(d(brr(i, 1)), ";") '获取该关键词对应的合并信息，并用split拆分

00. For j = 0 To UBound(t) '遍历拆分各项

00. brr(i, 2 + j) = t(j) '加入拆分信息到对应列位置

00. Next

00. Next

00. [g1].CurrentRegion = brr '输出查询结果。

00.

00.End Sub

普通浏览复制代码保存代码打印代码

01.Sub d_test()

02.

03. arr = [a1].CurrentRegion '获取原始数据压入数组arr （用当前区域较为智能）

04. brr = [g1].CurrentRegion '获取操作要求数据压入数组brr

05.

06. Set d = CreateObject("Scripting.Dictionary") '定义字典。这个不能省略。

07.

08. For i = 2 To UBound(arr) '遍历原始数据（从第2行开始）

09. d(arr(i, 1)) = arr(i, 2) & ";" & arr(i, 3) & ";" & arr(i, 4) '对每个关键词压入合并信息，以";"分隔。

10. Next

11.

12. For i = 2 To UBound(brr) '遍历查询要求数组brr

13. t = Split(d(brr(i, 1)), ";") '获取该关键词对应的合并信息，并用split拆分

14. For j = 0 To UBound(t) '遍历拆分各项

15. brr(i, 2 + j) = t(j) '加入拆分信息到对应列位置

16. Next

17. Next

18. [g1].CurrentRegion = brr '输出查询结果。

19.

20.End Sub

注释的注释：

1. Dim i%, d, arr, brr →不需要

如非必要，不需要用dim去定义所有的变量，麻烦，没有意义。

2. arr = Range("a2:d" & [a65530].End(3).Row).Value

我的代码为：arr = [a1].CurrentRegion

获取原始数据压入数组arr时，一般可以直接用当前区域，较为智能化。

当然，前提是，数据区域比较规范的矩形，没有空行，相邻没有无关内容。

3. d(arr(i, 1)) = arr(i, 2) & ";" & arr(i, 3) & ";" & arr(i, 4)

'目前是对原始数据中每个姓名关键词建立词典，并压入其它必要信息。用";"作分