修改汇总代码

lufabao7788

lsc900707 发表于 2018-8-22 12:16
其它列呢，要不要变？

lufabao7788

lufabao7788

请大家关注

lufabao7788

javascript:;

lufabao7788

lufabao7788 发表于 2018-8-22 13:06
javascript:;

不好意思lsc900707老师，我的水平太差，费了半天劲才贴上一个图片。
请帮忙修改，把原来的（单条件多列汇总）修改成这样的表头就行了。
谢谢！

lufabao7788

再次恳请高人帮忙

lsc900707

lufabao7788 发表于 2018-8-22 13:12
不好意思lsc900707老师，我的水平太差，费了半天劲才贴上一个图片。
请帮忙修改，把原来的（单条件多列 ...

表头自己弄一下，代码修改如下：

1. Sub gj23w98()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     With Sheets("第四次活动会员缴费表")
   
4.         r = .Cells(.Rows.Count, 13).End(3).Row
   
5.         arr = .Range("a8:p" & r)
   
6.     End With
   
7.     ReDim brr(1 To UBound(arr), 1 To 6)
   
8.     For x = 1 To UBound(arr)
   
9.         s = arr(x, 13)
   
10.         If d(s) = "" Then
    
11.             k = k + 1: d(s) = k
    
12.             brr(k, 1) = s
    
13.             brr(k, 2) = arr(x, 11)
    
14.             brr(k, 3) = arr(x, 7)
    
15.             For j = 4 To 6
    
16.                 brr(k, j) = arr(x, j + 10)
    
17.             Next
    
18.         Else
    
19.             brr(d(s), 2) = arr(x, 11) + brr(d(s), 2)
    
20.             brr(d(s), 3) = arr(x, 7) + brr(d(s), 3)
    
21.             For j = 4 To 5
    
22.                 brr(d(s), j) = arr(x, j + 10) + brr(d(s), j)
    
23.             Next
    
24.             brr(d(s), 6) = brr(d(s), 3) - brr(d(s), 4) - brr(d(s), 5)
    
25.         End If
    
26.     Next
    
27.     With Sheets("单条件多列汇总")
    
28.         .[a5].Resize(k, 6) = brr
    
29.     End With
    
30. End Sub
    

复制代码

lufabao7788

好的，正是我要的结果，大功告成。非常感谢！