作者：绿色风
分类：
时间：2022-08-18
浏览：68
楼主
kevinchengcw |
Q：如何用字典取代Hlookup或Vlookup函数？
A：对于从其他文件获取查询数据，我们一般是用Hlookup或Vlookup函数，但是这样要求两个文件都是打开的，而且对于大数据量的查询速度也不好，现在对于固定的数据源，我们完全可以用字典来取代这些函数，字典的优点的只需要用key就可以直接取出对应项，示例中代码如下：
- Public Dic As Object '定义公用的字典变量
- Private Sub Workbook_Open()
- Dim Wb
- Application.ScreenUpdating = False '关闭屏幕刷新，加快处理速度
- Set Dic = CreateObject("scripting.dictionary") '创建用于存放数据的字典
- Set Wb = GetObject(ThisWorkbook.Path & "\库.xls") '设定要找开的文件
- For n = 5 To Wb.Worksheets("浅孔爆破").Cells(2, Wb.Worksheets("浅孔爆破").Columns.Count).End(1).Column '统计文件中的数据区范围并逐个循环
- '判断字典中是否已存在该项目，并对未存在的项目进行添加
- If Not Dic.exists(Wb.Worksheets("浅孔爆破").Cells(2, n).Value) Then _
- Dic.Add Wb.Worksheets("浅孔爆破").Cells(2, n).Value, _
- Wb.Worksheets("浅孔爆破").Cells(7, n).Value & vbTab & Wb.Worksheets("浅孔爆破").Cells(8, n).Value & vbTab & Wb.Worksheets("浅孔爆破").Cells(9, n).Value
- Next n
- Wb.Close False '关闭打开的文件项
- Set Wb = Nothing '清空项目
- Application.ScreenUpdating = True '恢复屏幕刷新
- End Sub
- Private Sub Workbook_BeforeClose(Cancel As Boolean)
- Set Dic = Nothing '退出前清空字典项目
- End Sub
- Private Sub Worksheet_Change(ByVal Target As Range)
- Dim Rng As Range
- Application.EnableEvents = False '关闭事件响应，避免出现连锁反应
- If Dic.Count > 0 Then '判断字典是否为空
- For Each Rng In Target '列举发生变化的各个单元格，这样可以适应粘贴及下拉填充等情况
- If Rng.Column = 2 And Rng.Row >= 5 Then '判断变化单元格是否在B列第5行开始的数据区内
- If Rng <> "" And Dic.exists(Rng.Value) Then '如果单元格的变化后内容不为空且内容已存在于字典中，则提取对应的字典item项到对应单元格中
- Cells(Rng.Row, 3) = "浅孔爆破"
- Cells(Rng.Row, 7) = Split(Dic(Rng.Value), vbTab)(0)
- Cells(Rng.Row, 8) = Split(Dic(Rng.Value), vbTab)(1)
- Cells(Rng.Row, 9) = Split(Dic(Rng.Value), vbTab)(2)
- Else '如果单元格变化后内容为空，则清空对应项内容
- Cells(Rng.Row, 3) = ""
- Cells(Rng.Row, 7) = ""
- Cells(Rng.Row, 8) = ""
- Cells(Rng.Row, 9) = ""
- End If
- End If
- Next Rng
- End If
- Application.EnableEvents = True '打开事件响应
- End Sub
附示例文件。
 新建文件夹.rar
|
2楼
wnianzhong |
无处不在的VBA学习资源!谢谢! |
免责声明
有感于原ExcelTip.Net留存知识的价值及部分知识具有的时间限定性因素，
经与ExcelTip.Net站长Apolloh商议并征得其同意，
现将原属ExcelTip.Net的知识帖采集资料于本站点进行展示，
供有需要的人士查询使用，也慰缅曾经的论坛时代。
所示各个帖子的原作者如对版权有异议，
可与本人沟通提出，或于本站点留言，我们会尽快处理。
在此，感谢ExcelTip.Net站长Apolloh的支持，感谢本站点所有人**绿色风（QQ:79664738)**的支持与奉献，特此鸣谢！
------本人网名**KevinChengCW（QQ:1210618015)**原ExcelTip.Net总版主之一