EXCEL表明细表怎么自动汇总到另一个表

JKLJUN

EXCEL表明细表怎么自动汇总到汇总表里,在明细表里登记订单内容,然后自动汇总到另一个表,大神急帮助!!

abc123281

汇总的规则不明白  大家都无法帮助

JKLJUN

汇总表要的数据是将明细表里同个供应商同个订单号同个物料名称同个品种的数量金额汇总成一条信息,类似数据透视,但后续还要填写信息,数据透视表不方便使用

JKLJUN

顶贴,希望得到大神们的帮助!

JKLJUN

abc123281 发表于 2019-1-16 19:45
汇总的规则不明白  大家都无法帮助

汇总表要的数据是将明细表里同个供应商同个订单号同个物料名称同个品种的数量金额汇总成一条信息,类似数据透视,但后续还要填写信息,数据透视表不方便使用

abc123281

采购订单汇总123.rar (179.57 KB, 下载次数: 14)

2019-1-17 13:32 上传

点击文件名下载附件

grf1973

其实是按采购单号汇总。

1. Sub 汇总()
   
2.     Set d = CreateObject("scripting.dictionary")
   
3.     arr = Sheets("明细表").Range("b1:r" & Sheets("明细表").[b65536].End(3).Row)
   
4.     ReDim brr(1 To UBound(arr), 1 To 14)
   
5.     dzb = Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17)
   
6.     For i = 2 To UBound(arr)
   
7.         x = arr(i, 16) '以采购单号为唯一判断标记
   
8.         If Not d.exists(x) Then
   
9.             n = n + 1
   
10.             d(x) = n
    
11.             For j = 1 To 14: brr(n, j) = arr(i, dzb(j - 1)): Next
    
12.         Else
    
13.             p = d(x)
    
14.             brr(p, 7) = brr(p, 7) + arr(i, 10)
    
15.             brr(p, 9) = brr(p, 9) + arr(i, 12)
    
16.         End If
    
17.     Next
    
18.     Sheets("汇总表").[b21].Resize(n, 14) = brr
    
19. End Sub
    

复制代码

JKLJUN

abc123281 发表于 2019-1-17 13:32

你好!我添加明细按"按钮"汇总没有更新资料

JKLJUN

grf1973 发表于 2019-1-17 14:08
其实是按采购单号汇总。

您好!实在不好意思,对VBA不熟,根据您给的代码,做了,但更新明细表内容汇总没有自动更新

grf1973

1. Sub 汇总()
   
2.     Dim brr
   
3.     Set d = CreateObject("scripting.dictionary")
   
4.     arr = Sheets("明细表").Range("b1:r" & Sheets("明细表").[b65536].End(3).Row)
   
5.     dzb = Array(1, 2, 3, 4, 6, 9, 10, 11, 12, 13, 14, 15, 16, 17)
   
6.     With Sheets("汇总表")   '不改变原有汇总表,只做更新
   
7.         n = .[n65536].End(3).Row - 1
   
8.         If n > 0 Then    '表示原有汇总表有内容
   
9.             brr = .Range("b2:o" & n + UBound(arr))
   
10.             For i = 1 To UBound(brr)
    
11.                 d(brr(i, 13)) = i
    
12.                 brr(i, 7) = 0: brr(i, 9) = 0
    
13.             Next
    
14.         Else   '表示原来是空表
    
15.             ReDim brr(1 To UBound(arr), 1 To 14)
    
16.         End If
    
17.         For i = 2 To UBound(arr)
    
18.             x = arr(i, 16) '以采购单号为唯一判断标记
    
19.             If Not d.exists(x) Then
    
20.                 n = n + 1
    
21.                 d(x) = n
    
22.                 For j = 1 To 14: brr(n, j) = arr(i, dzb(j - 1)): Next
    
23.             Else
    
24.                 p = d(x)
    
25.                 brr(p, 7) = brr(p, 7) + arr(i, 10)
    
26.                 brr(p, 9) = brr(p, 9) + arr(i, 12)
    
27.             End If
    
28.         Next
    
29.         .[b2].Resize(n, 14) = brr
    
30.     End With
    
31. End Sub
    

复制代码