[已解决]有多行收款记录,如何在一行统计

lzpbl

“收款登记表”同一套房有多行收款记录，用“汇总表”方式来汇总，如何编VBA代码，谢谢大师帮忙

最佳答案

月排行榜 / 总排行榜

grf1973

2017-3-28 15:21

1. Sub 汇总()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For I = 2 To UBound(arr)
   
5.         x = arr(I, 2)
   
6.        If Len(x) > 0 Then d(x) = d(x) & "," & I
   
7.     Next
   
8.     Dim brr(1 To 1000, 1 To 31)
   
9.     For Each x In d.keys   '对于每个房号
   
10.         xrr = Split(d(x), ",")
    
11.         n = n + 1   '新增一条记录
    
12.         I = xrr(1)
    
13.         brr(n, 1) = n
    
14.         For j = 2 To 11       '前11列固定内容
    
15.             brr(n, j) = arr(I, j)
    
16.         Next
    
17.         For k = 1 To UBound(xrr)      '后4列一组收款情况
    
18.             I = xrr(k)
    
19.             brr(n, j) = arr(I, 12)   '收款日期
    
20.             brr(n, j + 1) = arr(I, 13)     '收款
    
21.             brr(n, j + 3) = arr(I, 18)   '收据编号
    
22.             j = j + 4
    
23.         Next
    
24.     Next
    
25.     Sheet2.[a7:ae1006] = ""
    
26.     Sheet2.[a7].Resize(n, 31) = brr
    
27. End Sub
    

复制代码

跳转到最佳答案楼层

grf1973

1. Sub 汇总()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheet1.[a1].CurrentRegion
   
4.     For I = 2 To UBound(arr)
   
5.         x = arr(I, 2)
   
6.        If Len(x) > 0 Then d(x) = d(x) & "," & I
   
7.     Next
   
8.     Dim brr(1 To 1000, 1 To 31)
   
9.     For Each x In d.keys   '对于每个房号
   
10.         xrr = Split(d(x), ",")
    
11.         n = n + 1   '新增一条记录
    
12.         I = xrr(1)
    
13.         brr(n, 1) = n
    
14.         For j = 2 To 11       '前11列固定内容
    
15.             brr(n, j) = arr(I, j)
    
16.         Next
    
17.         For k = 1 To UBound(xrr)      '后4列一组收款情况
    
18.             I = xrr(k)
    
19.             brr(n, j) = arr(I, 12)   '收款日期
    
20.             brr(n, j + 1) = arr(I, 13)     '收款
    
21.             brr(n, j + 3) = arr(I, 18)   '收据编号
    
22.             j = j + 4
    
23.         Next
    
24.     Next
    
25.     Sheet2.[a7:ae1006] = ""
    
26.     Sheet2.[a7].Resize(n, 31) = brr
    
27. End Sub
    

复制代码

lzpbl

grf1973 发表于 2017-3-28 15:21

谢谢，大师，但我的要求是汇总表已有房号而且是按顺序排列的，就是要求按房号汇总其他数据