Excel VBA 多条件查询

用以下两个公式都可以实现多条件查询，同样也可以用VBA代码来实现

函数公式1： '=INDEX(Sheet3!$F$2:$F$20,MATCH(B2&C2&D2&E2,Sheet3!$B$2:$B$20&Sheet3!$C$2:$C$20&Sheet3!$D$2:$D$20&Sheet3!$E$2:$E$20,0))

函数公式2： '=LOOKUP(1,0/(B3&C3&D3&E3=stock!$B$2:$B$20&stock!$C$2:$C$20&stock!$D$2:$D$20&stock!$E$2:$E$20),stock!$F$2:$F$20)

 

Sub 多条件查询()
Dim arr, brr, d, s$, i&, t$
Set d = CreateObject("scripting.dictionary") '创建字典
arr = Sheets(2).Range("b2", Sheets(2).[h65536].End(3)).Value '将所要查询的区域定义到数组arr中
 For i = 1 To UBound(arr)
    s = Join(Application.Index(Application.Index(arr, i, 0), Array(1, 2, 3, 4)), "|") '将数组arr每行的四个元素通过"|"拼接成为一个字符串
    d(s) = arr(i, 6) '数组arr的第6列元素存入字典
 Next
brr = Sheets(4).Range("b2", Sheets(4).[h65536].End(3)).Value '当前要查询的target区域定义到数组brr中
 For i = 1 To UBound(brr)
    t = Join(Application.Index(Application.Index(brr, i, 0), Array(1, 2, 3, 4)), "|")
    If d.exists(t) Then brr(i, 5) = d(t) Else brr(i, 5) = 0
 Next
Sheets(4).[b2].Resize(UBound(brr), UBound(brr, 2)) = brr '重新定义数组区域，并将brr重新赋值给它
Set d = Nothing

End Sub