vba实现vlookup功能，条件在多列，求大神

vilcent2014

vba实现vlookup功能，条件在多列，求大神

vilcent2014

vba实现vlookup功能，条件在多列，求大神

YZC51

请参考
Function WLOOKUP(X As Range, M As Variant, Optional a = 1, Optional b = 2)
    '比VLOOKUP函数更强大的函数:参数 a 查询第几个；b 返回第几列，可以为负数。
    Dim i As Integer
    i = Application.CountIf(M, X)
    Set M = Intersect(M.Parent.UsedRange, M)
    For Each MR In M
       If MR.Value = X Then
           y = y + 1
         If y > i Then Exit Function
           If y = a Then
           WLOOKUP = MR.Offset(0, b).Value
           End If
         End If
    Next MR
End Function
论坛上高人的代码

vilcent2014

朱荣兴 发表于 2018-12-25 10:33
result(i, 3) = arr(j, 5)
修改为
result(i, 3) = arr(j, 4)

大神，不是我的意思是，如果条件在单列，我学会了使用，如果在多列这种情况下，怎么用，看我上面发的带图片的附件，附件里面公式我做好了，谢谢！！！！！！

micch

1. =INDEX(销售台帐!B:B,IFNA(MATCH(A4,销售台帐!C:C,),4^8))&""

复制代码

用index+match也行。你说的多列条件，是指哪些列是条件？？

dsmch

1. Sub dsmch()
   
2. Dim arr, d, i&, j%
   
3. Set d = CreateObject("scripting.dictionary")
   
4. arr = Sheet1.Range("a1").CurrentRegion
   
5. For i = 2 To UBound(arr)
   
6.     d(arr(i, 3)) = i
   
7. Next
   
8. Sheet2.Activate
   
9. For i = 3 To 26
   
10.     For j = 3 To 23 Step 5
    
11.         If d.exists(Cells(i, j - 2).Value) Then
    
12.             n = d(Cells(i, j - 2).Value)
    
13.             Cells(i, j) = arr(n, 2)
    
14.             Cells(i, j + 1) = arr(n, 5)
    
15.             Cells(i, j + 2) = arr(n, 4)
    
16.         End If
    
17.     Next
    
18. Next
    
19. End Sub

复制代码

YZC51

请参考
Sub test()
    Set d = CreateObject("Scripting.Dictionary")
    arr = Sheet2.[a1].CurrentRegion
    brr = Sheet1.[a1].CurrentRegion
    For i = 3 To UBound(arr)
   For j = 3 To UBound(arr, 2) Step 5
    s = arr(i, j - 2)
    arr(i, j) = WLOOKUP(s, Sheet1.[B:E], , -1)
    arr(i, j + 1) = WLOOKUP(s, Sheet1.[B:E], , 2)
    arr(i, j + 2) = WLOOKUP(s, Sheet1.[B:E], , 1)
    Next
    Next
    Sheet2.[a1].CurrentRegion = arr
End Sub

Function WLOOKUP(X, M As Variant, Optional a = 1, Optional b = 2)
    '比VLOOKUP函数更强大的函数:参数 a 查询第几个；b 返回第几列，可以为负数。
    Dim i As Integer
    i = Application.CountIf(M, X)
    Set M = Intersect(M.Parent.UsedRange, M)
    For Each MR In M
       If MR.Value = X Then
           y = y + 1
         If y > i Then Exit Function
           If y = a Then
           WLOOKUP = MR.Offset(0, b).Value
           End If
         End If
    Next MR
End Function

YZC51

请参考
vba实现vlookup功能，多列求助.rar (84.3 KB, 下载次数: 221)

2018-12-25 11:45 上传

点击文件名下载附件