请大神用VB指导，求助

石来运转6888

请大神用VB指导，求助，谢谢。

ykcbf1100

昨天不是发过了吗？

chxw68

详见附件。

ykcbf1100

查到的结果和希望的结果不完全一样啊，请楼主再核对一下。

ykcbf1100

参与一下。。。

1. Sub ykcbf()  '//2024.4.18
   
2.     Set d = CreateObject("Scripting.Dictionary")
   
3.     With Sheets("原表")
   
4.         r = .Cells(Rows.Count, 2).End(3).Row
   
5.         arr = .[a1].Resize(r, 14)
   
6.         For i = 2 To UBound(arr)
   
7.             For j = 2 To 3
   
8.                 s = arr(i, j)
   
9.                 d(s) = arr(i, 4)
   
10.             Next
    
11.         Next
    
12.         For i = 2 To UBound(arr)
    
13.             s = arr(i, 13)
    
14.             If arr(i, 13) <> Empty And arr(i, 14) = Empty Then
    
15.                 If d.exists(s) Then
    
16.                     arr(i, 14) = d(s)
    
17.                 Else
    
18.                     arr(i, 14) = ""
    
19.                 End If
    
20.             End If
    
21.         Next
    
22.         .[n1].Resize(r, 1) = Application.Index(arr, 0, 14)
    
23.     End With
    
24.     Set d = Nothing
    
25.     MsgBox "OK！"
    
26. End Sub
    

复制代码