vba 字典_vba字典实现一对多查询

最新推荐文章于 2024-05-30 10:39:32 发布

weixin_39666782

最新推荐文章于 2024-05-30 10:39:32 发布

阅读量5.6k

点赞数 4

文章标签： vba 字典

之前讲的都是vba实现一对一查询，今天讲讲如何利用字典实现一对多查询。

首先回顾下一对一查询：

思路如下：

1、创建字典及3个数组

2、将源数据放入数组arr，遍历数组arr将数组存入字典d(arr)

3、将要查询的key值放入数组brr

4、利用字典进行查询d(brr)，将查询的值放入crr

5、在H列输出crr

代码如下：

Sub Dictionary_一对一()
t = Timer
Dim arr, brr, crr, d, i&
Sheets("Data").Activate
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Data").Range("a1").CurrentRegion
brr = Range("G1").CurrentRegion
ReDim crr(1 To UBound(brr), 1 To 1) '结果数组
For i = 1 To UBound(arr)
    d(arr(i, 1)) = arr(i, 2)
Next
For i = 1 To UBound(brr)
    crr(i, 1) = d(brr(i, 1))
Next
Range("H1").Resize(UBound(crr)) = crr
MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒"
End Sub

运行过程如下：

接下来讲讲一对多查询：

思路如下：

1、创建字典及1个数组

2、将源数据放入数组arr，遍历数组arr将数组(arr(i,2),arr(i,3))存入字典d(arr)

3、利用字典进行查询，将查询的值放在H列、I列中

代码如下：

Sub Dictionary_一对多()
t = Timer
Dim arr, d, i&, a&
Sheets("Data").Activate
Set d = CreateObject("scripting.dictionary")
arr = Sheets("Data").Range("a1").CurrentRegion
For i = 1 To UBound(arr)
    d(arr(i, 1)) = Array(arr(i, 2), arr(i, 3))
Next
 a = Sheets("Data").Range("G1048576").End(xlUp).Row
 For Each Rng In Range("G1:G" & a) '在自己需要查找的信息中开始遍历
  Rng.Offset(0, 1).Resize(1, 2) = d(Rng.Value) '查找寻找单元格中的值
 Next
MsgBox "一共用时：" & Format(Timer - t, "#0.0000") & " 秒"
End Sub

运行过程如下：