表2 根据 表1 查找相对应值

朱小猪

请大伙帮帮忙

ykcbf1100

附件供参考。。。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.28
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("Sheet1")
   
4.         r = .Cells(Rows.Count, 1).End(3).Row
   
5.         c = .UsedRange.Columns.Count
   
6.         arr = .[a1].Resize(r, c)
   
7.     End With
   
8.     For i = 1 To UBound(arr) Step 9
   
9.         For j = 2 To UBound(arr, 2)
   
10.             s = arr(i + 1, 1) & "|" & arr(i + 2, j)
    
11.             If arr(i + 2, j) <> Empty Then
    
12.                 d(s) = arr(i + 6, j)
    
13.             End If
    
14.         Next
    
15.     Next
    
16.     With Sheets("Sheet2")
    
17.         r = .Cells(Rows.Count, 1).End(3).Row
    
18.         c = .UsedRange.Columns.Count
    
19.         arr = .[a1].Resize(r, c)
    
20.         For i = 2 To UBound(arr)
    
21.             For j = 3 To UBound(arr, 2) - 1
    
22.                 s = arr(i, 1) & "|" & arr(1, j)
    
23.                 If d.exists(s) Then
    
24.                     arr(i, j) = d(s)
    
25.                 End If
    
26.             Next
    
27.             arr(i, c) = Val(arr(i, c - 3)) + Val(arr(i, c - 2)) + Val(arr(i, c - 1))
    
28.         Next
    
29.         .[a1].Resize(r, c) = arr
    
30.         .[a1].Resize(r, c).Borders.LineStyle = 1
    
31.     End With
    
32.     Set d = Nothing
    
33.     MsgBox "OK！"
    
34. End Sub
    

复制代码

朱小猪

ykcbf1100 发表于 2024-4-28 14:32
附件供参考。。。

大哥厉害，感谢感谢