多列查找

夏日生花

多列查找，请大神抽空指导一下，谢谢！

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.5.7
   
2.     Application.ScreenUpdating = False
   
3.     Set d = CreateObject("Scripting.Dictionary")
   
4.     With Sheets("查找")
   
5.         r = .Cells(Rows.Count, "t").End(3).Row
   
6.         arr = .[t1].Resize(r, 3)
   
7.         For i = 3 To UBound(arr)
   
8.             s = CStr(arr(i, 1)) & "|" & CStr(arr(i, 2))
   
9.             d(s) = arr(i, 3)
   
10.         Next
    
11.         r = .Cells(Rows.Count, "n").End(3).Row
    
12.         arr = .[n1].Resize(r, 4)
    
13.         For i = 3 To UBound(arr)
    
14.             s = CStr(arr(i, 2)) & "|" & CStr(arr(i, 3))
    
15.             If d.exists(s) Then
    
16.                 arr(i, 4) = d(s)
    
17.             End If
    
18.         Next
    
19.         .Columns("n:p").NumberFormatLocal = "@"
    
20.         .[n1].Resize(r, 4) = arr
    
21.         d.RemoveAll
    
22.         arr = .[n1].Resize(r, 4)
    
23.         For i = 3 To UBound(arr)
    
24.             s = CStr(arr(i, 1))
    
25.             d(s) = i
    
26.         Next
    
27.         r = .Cells(Rows.Count, "a").End(3).Row
    
28.         brr = .[a1].Resize(r, 11)
    
29.         ReDim crr(1 To r, 1 To 3)
    
30.         For i = 3 To UBound(brr)
    
31.             s = CStr(brr(i, 3))
    
32.             m = m + 1
    
33.             If d.exists(s) Then
    
34.                 crr(m, 1) = arr(d(s), 2)
    
35.                 crr(m, 2) = arr(d(s), 3)
    
36.                 crr(m, 3) = arr(d(s), 4)
    
37.             End If
    
38.         Next
    
39.         .Columns("i:k").NumberFormatLocal = "@"
    
40.         .[i3].Resize(m, 3) = crr
    
41.     End With
    
42.     Application.ScreenUpdating = True
    
43.     MsgBox "OK！"
    
44. End Sub
    

复制代码

gwjkkkkk

写个公式Q3，数组三键

1. =VLOOKUP(O3&P3,IF({1,0},$T$3:$T$10&$U$3:$U$10,$V$3:$V$10),2,)

复制代码

roserice

=CHOOSECOLS(FILTER($T$2:$V$9,$T$2:$T$9=O3),3)