[已解决]如何快速汇总

JLxiangwei

auqfbgjw 发表于 2011-11-17 08:44
楼上的好，水平好高。现在把附件的格式修改了，列出增加了，麻烦您帮我弄一下吧。昨天编出来数据好像一个客 ...

不是单纯的按日期吧？看你的模拟表倒像是按日期和客户名称一起的

JLxiangwei

auqfbgjw 发表于 2011-11-17 08:44
楼上的好，水平好高。现在把附件的格式修改了，列出增加了，麻烦您帮我弄一下吧。昨天编出来数据好像一个客 ...

1. Sub aa()
   
2.     Dim arr3, arr2, arr, arr1(1 To 10000, 1 To 7), x, y, z, k, D, m, n
   
3.     Set D = CreateObject("Scripting.Dictionary")
   
4.     arr3 = Range("a1:g1")
   
5.     arr2 = Range("e" & Range("e65536").End(xlUp).Row & ":g" & Range("g65536").End(xlUp).Row)
   
6.     arr = Range("a2:g" & Range("b65536").End(xlUp).Row)
   
7.     Range("i1:o10000").ClearContents
   
8.     For x = 1 To UBound(arr)
   
9.         If D.Exists(arr(x, 1) & arr(x, 4)) Then
   
10.             y = D(arr(x, 1) & arr(x, 4))
    
11.             For n = 1 To 4
    
12.                 arr1(y, n) = arr(x, n)
    
13.             Next n
    
14.             For n = 5 To 7
    
15.                 arr1(y, n) = arr1(y, n) + arr(x, n)
    
16.             Next n
    
17.         Else
    
18.             k = k + 1
    
19.             D(arr(x, 1) & arr(x, 4)) = k
    
20.             For z = 1 To 7
    
21.                 arr1(k, z) = arr(x, z)
    
22.             Next z
    
23.         End If
    
24.     Next x
    
25.     Range("i1:o1") = arr3
    
26.     Range("i2").Resize(D.Count, 7) = arr1
    
27.     m = 2 + D.Count
    
28.     Range("i" & m) = "小计"
    
29.     Range("m" & m & ":o" & m) = arr2
    
30. End Sub
    

复制代码