麻烦老师解决一下根据字典按多条件查询的问题

shi19880329

根据字典查询问题，感谢感谢！

chxw68

1. Sub test()
   
2.     Dim r%, i%
   
3.     Dim arr, brr
   
4.     Dim d As Object
   
5.     Set d1 = CreateObject("scripting.dictionary")
   
6.     Set d2 = CreateObject("scripting.dictionary")
   
7.     With Worksheets("sheet2")
   
8.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
   
9.         arr = .Range("a2:d" & r)
   
10.         For i = 1 To UBound(arr)
    
11.             xm = arr(i, 2) & "+" & arr(i, 3)
    
12.             d1(xm) = arr(i, 4)
    
13.         Next
    
14.         For j = 7 To 13 Step 6
    
15.             r = .Cells(.Rows.Count, j).End(xlUp).Row
    
16.             arr = .Cells(2, j).Resize(r - 1, 3)
    
17.             For i = 1 To UBound(arr)
    
18.                 xm = arr(i, 1) & "+" & arr(i, 2)
    
19.                 d2(xm) = arr(i, 3)
    
20.             Next
    
21.         Next
    
22.     End With
    
23.     With Worksheets("sheet1")
    
24.         r = .Cells(.Rows.Count, 1).End(xlUp).Row
    
25.         arr = .Range("a2:g" & r)
    
26.         For i = 1 To UBound(arr)
    
27.             xm = arr(i, 2) & "+" & arr(i, 3)
    
28.             If d1.exists(xm) Then
    
29.                 arr(i, 4) = d1(xm)
    
30.             End If
    
31.             xm = arr(i, 5) & "+" & arr(i, 6)
    
32.             If d2.exists(xm) Then
    
33.                 arr(i, 7) = d2(xm)
    
34.             End If
    
35.         Next
    
36.         .Range("a2:g" & r) = arr
    
37.     End With
    
38. End Sub
    

复制代码

chxw68

详见附件。

zjzyj

附件供参考     

shi19880329

zjzyj 发表于 2023-4-11 20:07
附件供参考

再麻烦老师一下，一行有多个击数该怎么查找。没有数据不查找。

shi19880329

chxw68 发表于 2023-4-11 20:00

老师这种几列数据的该怎么处理。

shi19880329

chxw68 发表于 2023-4-11 20:00
详见附件。

麻烦老师修改下代码。。。。。。

shi19880329

zjzyj 发表于 2023-4-11 20:07
附件供参考

麻烦老师修改下代码。。。。

chxw68

shi19880329 发表于 2023-4-13 15:47
老师这种几列数据的该怎么处理。

把修改后的文件传上来。

shi19880329

chxw68 发表于 2023-4-13 16:23
把修改后的文件传上来。

感谢。。。。。！