分享: VBA自定义函数vlookup加强版 一对多查询 - 已更新

johnny05

近来学习数组和字典, 同时亦在论坛中看到不少关于一对多的查询, 博采众长, 利用数组+字典自定义了一个mlookup一对多的查询函数, 与大家分享, 其中难免有不足之处, 请大家指点

[ 本帖最后由 johnny05 于 2009-2-17 12:07 编辑 ]

dxy27

不错！可以改进如下：
Function mlookup(a As String, b As Range, c As Long) As String
Dim arr()
arr = b     '   将数组定义为被查询的数据源区域
Dim i As Long
Dim dic As Object
Set dic = CreateObject("scripting.dictionary")
For i = 1 To UBound(arr)
    If arr(i, 1) = a Then       '   当数组中第一列的值与查找目标值相同时,
    '  If arr(i, 1) = a And arr(i, c) <> "" Then         '   如果查询的值忽略空值, 则需要使用此语句
        dic.Add i, arr(i, c)        '   将查询需要返回的值添加到字典中的item
    End If
Next i
Erase arr()     '   清空数组
Dim vl(), va As String
vl = dic.items      '   将字典中所有item转为数组
Set dic = Nothing   '   清空字典
'For i = 0 To UBound(vl)     '   将数组中的值组合在一起, 注意: 下标从0开始,
'    va = va & "," & vl(i)
'Next i
If UBound(vl) = -1 Then
    mlookup = "None"        '   无匹配记录的显示结果
Else
    mlookup = Join(vl, ",")      '   转化将查询结果
    Erase vl        '   清空数组
End If
End Function

johnny05

妙
这样速度应该更快, 更简洁,明了.

If UBound(vl) = -1 Then
    mlookup = "None"        '   无匹配记录的显示结果
Else
    mlookup = Join(vl, ",")      '   转化将查询结果
    Erase vl        '   清空数组
End If

[ 本帖最后由 johnny05 于 2009-2-15 10:55 编辑 ]

johnny05

自己顶一下,让更多的人看到

xbzg1996

我终于找到我要的东东了，可我不太会vba，可否请各位高手帮帮我解决一下啊，用vlookUP函数严重影响速度啊！

cylcyj

要是能把返回的结果，每个结果都放在不同单元格里就更好了，这样更实用些呀

xzdfxly

真不错，是不是有办法，让他显示在同一行的不同的单元格内。

ccs4851

可以实现，用数组公式。显示在同一行的不同的单元格内。

ywgphy2

hhhhhhhhhhhhhhhhhh

spyfather

Function strfind(i, j As Range, col1 As Integer, col2 As Integer)
num_start_row = j.End(xlToLeft).Row
num_end_row = j.End(xlDown).Row
str_result = i
jj = 1
For ii = num_start_row To num_end_row
str_find = j.Cells(jj, 1).Value
If (str_result = str_find) Then
str_col1 = j.Cells(jj, col1).Value
str_col2 = j.Cells(jj, col2).Value
End If
jj = jj + 1
Next
If (str_col1 = Null Or str_col1 = "") Then
strfind = "未找到结果"
Else
strfind = CStr(str_col1) + "_" + CStr(str_col2)
End If
End Function

这个是我写的，我觉得这样更简单，请赐教。