用数据字典替代Vlookup函数，提高查询效率

zzm527292

近日编写一工具，3万多条的记录进行交叉比对，VBA调用Vlookup函数进行计算，用8G内存64位系统运行，结果还是长时间假死，运行要达6、7分钟才能出现结果，将复合公式分解，查询速度也未见明显提高。
为解决速度问题，在网上查询Vlookup替代方法，找到了通过建立字典，提高效率，在参考高手文献代码的基础上，改编成了Vlookup_t子函数，在程序中多次调用，目前程序运行不足1分钟，提高明显，现将测试时的程序上传，希望能给需要的朋友有所帮助。
Vlookup_t(mc As String, col_y As Integer, sheety As String, col_s As String, col_p As Integer)
mc 为源数据区域的自定义名称，将数据区域确定为自定义名称，便于调用；
col  为源数据区域中要选用的列相对第一列的数字（也就是查询后要找到的值）；
sheety 为要使用此函数的目的工作表名；
col_s   为要查询列的起始单元格位置；
col_p  为要填写查询结果的列相对于col_s所在列的数字

Public Sub Vlookup_t(mc As String, col_y As Integer, sheety As String, col_s As String, col_p As Integer)
'

'关闭自动计算和屏幕刷新，以提高效率
Application.Calculation = xlCalculationManual
Application.ScreenUpdating = False

Dim rng As Range
Dim col As String
Dim col_n As Integer

' 词典
Set map_dict = CreateObject("Scripting.Dictionary")

' 初始化变量
Set rng = Range(mc)
col = Left(col_s, 1)
col_n = Val(Mid(col_s, 2, Len(col_s))) - 1

' 遍历自定义数据行，关键数据插入词典
For i = 1 To rng.Rows.Count
   ID_y = rng.Cells(i, 1).Value
   Data_y = rng.Cells(i, col_y).Value
   If Not map_dict.Exists(ID_y) Then
       map_dict.Add ID_y, Data_y
   End If
Next i

' 打开目的表
Set dispatch_sheet = Worksheets(sheety)
j = dispatch_sheet.Range(col & "999999").End(xlUp).Row - nb
Set my_rows = dispatch_sheet.Range(col_s).Resize(j, col_p ).Rows


' 遍历开通表，通过词典获得 machine_id 对应的一级分中心，插入开通表
For Each o_row In my_rows
   ID_y = o_row.Cells(1, 1).Value
   o_row.Cells(1, col_p).Value = map_dict.Item(ID_y)
Next o_row


' 销毁建立的词典
Set map_dict = Nothing

' 打开自动计算和屏幕刷新
Application.Calculation = xlCalculationAutomatic
Application.ScreenUpdating = True
'
End Sub




调用例子：
Sub test()

Vlookup_t "name1", 3, "Sheet2", "C3", 4

End Sub

vlookup_t.rar (18.34 KB, 下载次数: 811)

2014-5-11 23:21 上传

点击文件名下载附件

kaituo

能提升效率的东西是好东西，把强大函数送上更高一个档次的东西是好东西中的好东西

zuocloud

如何实现变量在excel字典中不存在，保持所在行数据不变

bmcuser

高手写的还不是很明白

sunny_8848

要是能直接输入单元格区域就好了，比如A1：A100这样的形式，感觉定义名称没有那么方便

yepulu

这个真需要。

厦门行

水平太差，我看不懂。

pinda

这个太好了！！！

goldowl2011

Mark .Thanks a lot.

blackttea1

Mark .Thanks a lot.