代码长了求老师帮忙优化 谢谢

全党

1. Sub shishi()
   
2. Dim brr()
   
3. T1 = Timer
   
4. Set d = CreateObject("Scripting.Dictionary")
   
5. arr库存 = Sheet2.Range("a1").CurrentRegion
   
6.    For kc = 2 To UBound(arr库存)
   
7.       Key = arr库存(kc, 1) & "," & arr库存(kc, 8)
   
8.       If arr库存(kc, 8) Like 委外 & "*" Then
   
9.        d(Key) = d(Key) + arr库存(kc, 9) * 0.9
   
10.       Else
    
11.        d(Key) = d(Key) + arr库存(kc, 9)
    
12.       End If
    
13.    Next
    
14. ReDim brr(1 To d.Count, 1 To 2)
    
15. For Each Key In d.keys
    
16. n = n + 1
    
17. brr(n, 1) = Split(Key, ",")(0): brr(n, 2) = d(Key)
    
18. Next
    
19. Set d = Nothing
    
20. Sheet1.Range("aa3:ab5000").ClearContents
    
21. Sheet1.Range("aa3").Resize(n, 2) = brr
    
22. T2 = Timer: MsgBox T2 - T1
    
23. End Sub

复制代码

jerry3770

全党 发表于 2024-5-8 16:07

谢谢老师的解答   您这只是做了个去重汇总   我这句后面的功能您帮我省掉了结果就不一样了（ReDim arra(1 To d.Count, 1 To 2（这句以前可以不用改（工作精有几个仓位是不可用的））)，这是料号对应相对的数量1对1输出，相当于做了次VLOOKUP查找。