关于按条件提取最后一个值并统一数值的疑问

瓶砸

测试.rar (21.84 KB, 下载次数: 3)

2019-1-19 13:57 上传

点击文件名下载附件

代码如下：

1. Sub 计划数量累加()
   
2.     '按名称查找后根据条件进行值的累加
   
3.     Dim arr, brr(), crr(), d As Object, temp As String, i As Long
   
4.     arr = Sheet1.Range("a2:o" & Range("f65536").End(xlUp).Row)
   
5.     ReDim brr(1 To UBound(arr))
   
6.     Set d = CreateObject("scripting.dictionary")
   
7.     For i = 1 To UBound(arr)
   
8.     temp = arr(i, 5) & arr(i, 6) & arr(i, 7)
   
9.         If Not d.Exists(temp) Then
   
10.             If arr(i, 15) = "待排产" Then
    
11.             d(temp) = arr(i, 8)
    
12.             'Else
    
13.             'd(temp) = 0
    
14.             End If
    
15.         brr(i) = arr(i, 8)
    
16.         Else
    
17.             If arr(i, 15) = "待排产" Then
    
18.             d(temp) = d(temp) + arr(i, 8)
    
19.             End If
    
20.             brr(i) = d(temp)
    
21.         End If
    
22.     Next
    
23.     Sheet2.Rows("1:65536").ClearContents
    
24.     Sheet2.Range("a1").Resize(UBound(arr)) = WorksheetFunction.Transpose(brr)
    
25.    
    
26. End Sub

复制代码

望各位老师帮忙看下怎样修改上述代码可以达到我想要的效果。

瓶砸

[笑哭]现在自己另外写了个FOR循环用着，勉强可以达到效果，但毕竟不如字典+数组的解法来得快些。