关于多条件求和，萌新求教

mmlzh

简化一下

1. Sub TJ1()
   
2.    Dim I&, J&, K&, D, Arr, Brr, Crr
   
3.    Set D = CreateObject("Scripting.Dictionary")
   
4.    Arr = Range("A3:D" & [A65535].End(xlUp).Row)
   
5.    Brr = Range("P1:P" & [P65535].End(xlUp).Row)
   
6.    For I = 1 To UBound(Brr)
   
7.       D(Brr(I, 1)) = ""
   
8.    Next
   
9.    ReDim Crr(0 To 999, 0 To 99)
   
10.    Crr(0, 0) = "产品ID\日期"
    
11.    For I = 1 To UBound(Arr)
    
12.       If Not D.Exists(Arr(I, 3)) Then J = J + 1: D(Arr(I, 3)) = J: Crr(J, 0) = Arr(I, 3)
    
13.       If Not D.Exists(Arr(I, 4)) Then K = K + 1: D(Arr(I, 4)) = K: Crr(0, K) = Arr(I, 4)
    
14.       If Not D.Exists(Arr(I, 1)) Then Crr(D(Arr(I, 3)), D(Arr(I, 4))) = Crr(D(Arr(I, 3)), D(Arr(I, 4))) + Arr(I, 2)
    
15.    Next
    
16.    Range("F2:O" & [F2].End(xlDown).Row).ClearContents
    
17.    [F2].Resize(J + 1, K + 1) = Crr
    
18.    Set D = Nothing
    
19. End Sub

复制代码