帮忙写一下日报表要求里面有，请大师帮忙

wqfcc

希望大师帮我解决一下，新手很无奈！

sry660

1. Sub 汇总()
   
2.     Dim arr, i&, j&, Tj, x, d, n&, p&, brr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     Tj = [h2]
   
5.     arr = Sheets(1).[a1].CurrentRegion
   
6.     ReDim brr(1 To UBound(arr), 1 To 9)
   
7.     For i = 2 To UBound(arr)
   
8.         x = arr(i, 2)
   
9.         If x = Tj Then
   
10.             x = arr(i, 2) & arr(i, 3)
    
11.             If Not d.exists(x) Then
    
12.                 n = n + 1
    
13.                 d(x) = n
    
14.                 brr(n, 1) = n: brr(n, 2) = arr(i, 3)
    
15.                 brr(n, 3) = "": brr(n, 4) = arr(i, 17)
    
16.                 brr(n, 5) = arr(i, 11): brr(n, 6) = arr(i, 12)
    
17.                 brr(n, 7) = arr(i, 14): brr(n, 8) = arr(i, 13): brr(n, 9) = Val(arr(i, 19))
    
18.             Else
    
19.                 p = d(x)
    
20.                 brr(p, 5) = brr(p, 5) + arr(i, 11): brr(p, 6) = brr(p, 6) + arr(i, 12)
    
21.                 brr(p, 7) = brr(p, 7) + arr(i, 14): brr(p, 8) = brr(p, 8) + arr(i, 13)
    
22.                 brr(p, 9) = brr(p, 9) + Val(arr(i, 19))
    
23.             End If
    
24.         End If
    
25.     Next
    
26.     [a4:i10000].ClearContents
    
27.     [a4].Resize(n, 9) = brr
    
28. End Sub

复制代码