[已解决]求报表汇总模块代替原函数公式

icenotcool

各位老师，想请老师帮我写报表汇总模块代替原函数公式作用，我想用vba直接核算黄色区域数据，想去掉“物资数据库”工作表的2条辅助列AS列、AT列，直接利用“”系统参数设置里面的黄色对应表。详情在附件内，谢谢老师了！附件 示例更新.rar (601.34 KB, 下载次数: 15)

2014-3-31 15:52 上传

点击文件名下载附件

最佳答案

月排行榜 / 总排行榜

grf1973

2014-4-1 14:37

做了一个“科室总账报表”。比较麻烦，主要是要考虑起止月份。由于你表中没数据，所以也无法检验。你自己搞点数据试试吧，有问题再说。

1. Sub 总账报表生成()
   
2.     arr = Sheets("系统参数设置").[b1].CurrentRegion
   
3.     Set D = CreateObject("scripting.dictionary")
   
4.     For I = 2 To UBound(arr)    '把"物资数据库"工作表"部门名称" 和  "科室总账报表"工作表"科室" 用字典联系起来
   
5.         D(arr(I, 1)) = arr(I, 2)
   
6.     Next
   
7.    
   
8.    
   
9.     Set d1 = CreateObject("scripting.dictionary")    '读入数据
   
10.     arr = Sheets("物资数据库").[a1].CurrentRegion
    
11.     For I = 2 To UBound(arr)
    
12.         bm = arr(I, 1): ks = D(bm)    '部门-->总帐科室
    
13.         XM = Left(arr(I, 44), 4)   '项目各类取前4位（办公用品(文具)=办公用品，办公用品(电脑)=办公用品）
    
14.         ny = Year(arr(I, 43)) & "-" & Month(arr(I, 43))    '统计年月2014-1
    
15.         xkey = ks & XM & ny    '字典的key：科室+项目+年月
    
16.         For j = 2 To 41
    
17.             d1(xkey) = d1(xkey) + arr(I, j)    '资产原值
    
18.         Next
    
19.     Next
    
20.    
    
21.     With Sheets("科室总账报表")
    
22.         arr = .[a3:o45]
    
23.         YF = .[c2]     '月份
    
24.         If Val(YF) > 0 Then      '根据C2判断统计的起始月、终止月
    
25.             smonth = Val(YF): emonth = Val(YF)
    
26.         ElseIf YF = "第一季度" Then
    
27.             smonth = 1: emonth = 3
    
28.         ElseIf YF = "第二季度" Then
    
29.             smonth = 4: emonth = 6
    
30.         ElseIf YF = "第三季度" Then
    
31.             smonth = 7: emonth = 9
    
32.         ElseIf YF = "第四季度" Then
    
33.             smonth = 10: emonth = 12
    
34.         ElseIf YF = "年度" Then
    
35.             smonth = 1: emonth = 12
    
36.         End If
    
37.         ''''''smonth = Month(.[s6]): emonth = Month(.[t6])
    
38.         
    
39.         For y = smonth To emonth
    
40.             ny = Year(Date) & "-" & y
    
41.             For I = 2 To UBound(arr)
    
42.                 ks = arr(I, 2)        '科室
    
43.                 s = 0
    
44.                 For j = 3 To 14   'C列到N列
    
45.                     XM = arr(1, j)       '项目
    
46.                     xkey = ks & XM & ny    'key：科室+项目+年月
    
47.                     arr(I, j) = arr(I, j) + d1(xkey)
    
48.                     s = s + arr(I, j)
    
49.                 Next
    
50.                 arr(I, 10) = arr(I, 10) + arr(I, 6) + arr(I, 9) '日用五金
    
51.                 arr(I, 13) = arr(I, 13) + arr(I, 11) + arr(I, 12) '低值易耗品
    
52.                 arr(I, 15) = arr(I, 15) + s '合计
    
53.             Next
    
54.         Next
    
55.         .[a3].Resize(UBound(arr), UBound(arr, 2)) = arr
    
56.         .Cells(39, 3).Resize(1, 13).Formula = "=sum(r4c:r[-1]c)"   '计算第39行“小计”
    
57.         .Cells(41, 3).Resize(1, 13).Formula = "=sum(r39c:r[-1]c)"   '计算第41行“合计”
    
58.         .Cells(45, 3).Resize(1, 13).Formula = "=sum(r41c:r[-1]c)"   '计算第45行“总计”
    
59.     End With
    
60.    
    
61. End Sub

复制代码

跳转到最佳答案楼层

grf1973

做了一个“科室总账报表”。比较麻烦，主要是要考虑起止月份。由于你表中没数据，所以也无法检验。你自己搞点数据试试吧，有问题再说。

1. Sub 总账报表生成()
   
2.     arr = Sheets("系统参数设置").[b1].CurrentRegion
   
3.     Set D = CreateObject("scripting.dictionary")
   
4.     For I = 2 To UBound(arr)    '把"物资数据库"工作表"部门名称" 和  "科室总账报表"工作表"科室" 用字典联系起来
   
5.         D(arr(I, 1)) = arr(I, 2)
   
6.     Next
   
7.    
   
8.    
   
9.     Set d1 = CreateObject("scripting.dictionary")    '读入数据
   
10.     arr = Sheets("物资数据库").[a1].CurrentRegion
    
11.     For I = 2 To UBound(arr)
    
12.         bm = arr(I, 1): ks = D(bm)    '部门-->总帐科室
    
13.         XM = Left(arr(I, 44), 4)   '项目各类取前4位（办公用品(文具)=办公用品，办公用品(电脑)=办公用品）
    
14.         ny = Year(arr(I, 43)) & "-" & Month(arr(I, 43))    '统计年月2014-1
    
15.         xkey = ks & XM & ny    '字典的key：科室+项目+年月
    
16.         For j = 2 To 41
    
17.             d1(xkey) = d1(xkey) + arr(I, j)    '资产原值
    
18.         Next
    
19.     Next
    
20.    
    
21.     With Sheets("科室总账报表")
    
22.         arr = .[a3:o45]
    
23.         YF = .[c2]     '月份
    
24.         If Val(YF) > 0 Then      '根据C2判断统计的起始月、终止月
    
25.             smonth = Val(YF): emonth = Val(YF)
    
26.         ElseIf YF = "第一季度" Then
    
27.             smonth = 1: emonth = 3
    
28.         ElseIf YF = "第二季度" Then
    
29.             smonth = 4: emonth = 6
    
30.         ElseIf YF = "第三季度" Then
    
31.             smonth = 7: emonth = 9
    
32.         ElseIf YF = "第四季度" Then
    
33.             smonth = 10: emonth = 12
    
34.         ElseIf YF = "年度" Then
    
35.             smonth = 1: emonth = 12
    
36.         End If
    
37.         ''''''smonth = Month(.[s6]): emonth = Month(.[t6])
    
38.         
    
39.         For y = smonth To emonth
    
40.             ny = Year(Date) & "-" & y
    
41.             For I = 2 To UBound(arr)
    
42.                 ks = arr(I, 2)        '科室
    
43.                 s = 0
    
44.                 For j = 3 To 14   'C列到N列
    
45.                     XM = arr(1, j)       '项目
    
46.                     xkey = ks & XM & ny    'key：科室+项目+年月
    
47.                     arr(I, j) = arr(I, j) + d1(xkey)
    
48.                     s = s + arr(I, j)
    
49.                 Next
    
50.                 arr(I, 10) = arr(I, 10) + arr(I, 6) + arr(I, 9) '日用五金
    
51.                 arr(I, 13) = arr(I, 13) + arr(I, 11) + arr(I, 12) '低值易耗品
    
52.                 arr(I, 15) = arr(I, 15) + s '合计
    
53.             Next
    
54.         Next
    
55.         .[a3].Resize(UBound(arr), UBound(arr, 2)) = arr
    
56.         .Cells(39, 3).Resize(1, 13).Formula = "=sum(r4c:r[-1]c)"   '计算第39行“小计”
    
57.         .Cells(41, 3).Resize(1, 13).Formula = "=sum(r39c:r[-1]c)"   '计算第41行“合计”
    
58.         .Cells(45, 3).Resize(1, 13).Formula = "=sum(r41c:r[-1]c)"   '计算第45行“总计”
    
59.     End With
    
60.    
    
61. End Sub

复制代码

icenotcool

谢谢老师，老师放入数据，低值办公用品这K列数据没有统计出来，还有统计季度时报表没有反应也没有起作用，老师“科室总账报表”的第46行，怎么也有数据出来的，老师我就着你的模块修改了另外一个成本模块，，但是“科室成本核算报表”第44行明明是空白科室怎么会有数据，请看附件 物资管理.rar (610.55 KB, 下载次数: 12)

2014-4-1 16:31 上传

点击文件名下载附件

grf1973

另外，建议请人编程把自己文件处理一下，选取一些有代表性的数据就可。你这附件太大了，保存一下要老半天。

grf1973

有数据就好调试了。
1、低值办公用品问题，因为起先是取的项目前4位作为Key，现在干脆改成全字符，只在办公用品（文具）那儿加了个判断。
2、统计季度时报表没有反应问题，因为是我没注意你的有效性里是“一季度”，我代码里写成了“第一季度”
3、科室为空却显示数值问题，我也搞不懂为什么会出现，重新对科室加了个判断，只在科室非空的前提下才累加计数。
请看附件。自己再调试一下，有问题再提出来吧。

icenotcool

老师，你是不是上传错附件了，怎么我下载下来，还是我自己原来那个附件呢？

grf1973

呵呵，可能传错了。

icenotcool

老师，我怎么 调整了时间2015年，起始日期        截至日期
                                             2015-1-1        2015-1-31
怎么还有数据的？我明明“物资数据库”2015年没有数据啊？

grf1973

只是按照数据有效性做的日期选择，没按你输入的起始日期、截止日期判断。如果要做的话，可以加上。

grf1973

重新改了一下程序，两个改动：
1、C2单元格发生改变后，S6，T6单元格随之改变。
2、直接通过判断“物资数据库”的“统计月份”是否在起止日期间确定是否统计。
代码如下：

1. Private Sub Worksheet_Change(ByVal Target As Range)        'C2单元格发生改变后，S6，T6单元格随之改变。
   
2.     If Target.Address <> [c2].Address Then Exit Sub
   
3.     YF = Target     '月份
   
4.     If Val(YF) > 0 Then      '根据C2判断统计的起始月、终止月
   
5.         smonth = Val(YF): emonth = Val(YF)
   
6.     ElseIf YF = "一季度" Then
   
7.         smonth = 1: emonth = 3
   
8.     ElseIf YF = "二季度" Then
   
9.         smonth = 4: emonth = 6
   
10.     ElseIf YF = "三季度" Then
    
11.         smonth = 7: emonth = 9
    
12.     ElseIf YF = "四季度" Then
    
13.         smonth = 10: emonth = 12
    
14.     ElseIf YF = "年度" Then
    
15.         smonth = 1: emonth = 12
    
16.     End If
    
17.     maxday = Day(DateSerial(Year(Date), emonth + 1, 0))   '取得指定月的最大天数（下一个月的第0天）
    
18.     [s6] = DateSerial(Year(Date), smonth, 1)       '起始日期
    
19.     [t6] = DateSerial(Year(Date), emonth, maxday)     '结束日期
    
20. End Sub
    
21. 
    
22. Sub 总账报表生成()
    
23.     arr = Sheets("系统参数设置").[b1].CurrentRegion
    
24.     Set D = CreateObject("scripting.dictionary")
    
25.     For I = 2 To UBound(arr)    '把"物资数据库"工作表"部门名称" 和  "科室总账报表"工作表"科室" 用字典联系起来
    
26.         D(arr(I, 1)) = arr(I, 2)
    
27.     Next
    
28.    
    
29.     sday = Sheets("科室总账报表").[s6]   '统计的起始日期
    
30.     eday = Sheets("科室总账报表").[t6]   '统计的结束日期
    
31.     Set d1 = CreateObject("scripting.dictionary")    '读入数据
    
32.     arr = Sheets("物资数据库").[a1].CurrentRegion
    
33.     For I = 2 To UBound(arr)
    
34.         xday = arr(I, 43)     '统计月份
    
35.         If xday >= sday And xday <= eday Then        '只统计在起始日期和结束日期之间的数据
    
36.             bm = arr(I, 1): ks = D(bm)    '部门-->总帐科室
    
37.             XM = arr(I, 44)   '项目
    
38.             If XM Like "办公用品*" Then XM = "办公用品"     '办公用品（文具）=办公用品
    
39.             xkey = ks & XM    '字典的key：科室+项目
    
40.             For j = 2 To 41
    
41.                 d1(xkey) = d1(xkey) + arr(I, j)    '资产原值
    
42.             Next
    
43.         End If
    
44.     Next
    
45.    
    
46.     With Sheets("科室总账报表")
    
47.         .Range("C4:O45").ClearContents
    
48.         arr = .[a3:o45]
    
49.         For I = 2 To UBound(arr)
    
50.             ks = arr(I, 2)        '科室
    
51.             If Len(ks) > 0 Then
    
52.                 s = 0
    
53.                 For j = 3 To 14   'C列到N列
    
54.                     XM = arr(1, j)      '项目
    
55.                     xkey = ks & XM     'key：科室+项目+年月
    
56.                     arr(I, j) = arr(I, j) + d1(xkey)
    
57.                     s = s + arr(I, j)
    
58.                 Next
    
59.                 arr(I, 10) = arr(I, 10) + arr(I, 6) + arr(I, 9) '日用五金
    
60.                 arr(I, 13) = arr(I, 13) + arr(I, 11) + arr(I, 12) '低值易耗品
    
61.                 arr(I, 15) = arr(I, 15) + s '合计
    
62.             End If
    
63.         Next
    
64.         .[a3].Resize(UBound(arr), UBound(arr, 2)) = arr
    
65.         .Cells(39, 3).Resize(1, 13).Formula = "=sum(r4c:r[-1]c)"   '计算第39行"小计"
    
66.         .Cells(41, 3).Resize(1, 13).Formula = "=sum(r39c:r[-1]c)"   '计算第41行"合计"
    
67.         .Cells(45, 3).Resize(1, 13).Formula = "=sum(r41c:r[-1]c)"   '计算第45行"总计"
    
68.     End With
    
69. End Sub

复制代码