利用Excel的VBA代码实现自动化“收集原始数据、汇总计算和报表”

1、无利用利用 ExcelExcel 的的 VBAVBA 代码实现自动化代码实现自动化“收集原始数据、汇总计算和报表收集原始数据、汇总计算和报表”联系人：杨先生电话电子邮箱：以房地产销售数据为例。两个销售中心以 Excel 记录销售活动，原始数据和直接使用公式形成的表格模板如下。黄色标题名称为公式项，根据已知数据自动计算。1原始数据收集表1.1 产品表：所有房屋产品，主房、辅房（储藏室、车库、车位等）的基本信息；标题名称标题名称含义房行房行=ROW(主房)-ROW(主房#标题)，动态的数据行号买受人买受人=IFERROR(INDEX(销售买受人,售行),)，当前买受人项目

2、项目销售项目名称分区分区分区名称分期分期分期名称楼楼数字楼号单单数字单元号层层数字楼层房房数字方位编号面积面积预售面积预售价预售价预售价格产权产权产权面积售次售次=COUNTIFS(销售主房索引,主房索引)，当前的销售次数，退房、换房不删除数据，所以用售次区别售行售行对应的销售数据行。房号房号=VALUE(单&TEXT(层,00)&TEXT(房,00)，如 1 单元 1 层东户表示为 1-0101（数字的自定义格式）主房索引主房索引=INDEX(项目分区代码,MATCH(项目&分区,项目分区分区名称,0)&分期&TEXT(楼,00)&TEXT(房

3、号,00000)， 用于表间互查数据销售索引销售索引=IFERROR(主房索引&ABS(售序),) ，用于表间互查数据总房款总房款已收已收待收待收1.2 销售表：每次销售活动的真实记录，产品的组合及从产品表查取的基本信息；标题名称标题名称含义售行售行=ROW(主房)-ROW(销售#标题)分区分区分区名称分期分期分期名称房号房号手工输入数字（自定义格式）售序售序当前的销售次数，退房、换房不删除数据，所以用售次区别无买受人买受人业务姓名顾问顾问置业顾问姓名实售价实售价储号储号储款储款库号库号库款库款位号位号位款位款总房款总房款合同中填写的总金额总款总款=ROUND(SUM(主房款,储款,库

4、款,位款),0)，自动计算的总金额差异差异=总房款-总款主房面积主房面积=INDEX(主房面积,房行)认购日期认购日期=IFERROR(INDEX(房款实收日,MATCH(销售索引&定金,房款款类索引,0),)，实交定金日期主房款主房款=ROUND(实售价*主房面积,0)房约日房约日购房合同签署日期房约价房约价合同单价买受人身份证号买受人身份证号共有人共有人共有人身份证号共有人身份证号合同交房日合同交房日贷行贷行贷含贷含贷款对象包含储藏室（C）、车库（K）等贷额贷额公贷公贷资料日资料日贷款资料合格日贷约日贷约日贷款合同签署日商放商放=SUMIFS(房款金额,房款销售索引,销售索引,房款

5、实收日,40544,房款款类,商贷)，商业贷款到账日公放公放=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,公贷)，公积金贷款到账日已收已收=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,找差)，不含找差待收待收=IF(售序0,总房款-已收,0)房行房行=MATCH(主房索引,主房主房索引,0)，对应产品表的行号主房索引主房索引=INDEX(项目分区代码,MATCH(房款!$B$1&分区,项目分区分区名称,0)&分期&TEXT(房号,0000000)销售索引销售索引=主房索引&ABS(售序)

6、换房换房因业务换房造成本次销售无效时，记录换成了哪套房子1.3 房款表：按合约应交、实交价款的信息标题名称标题名称含义无款款行行=ROW(房款)-ROW(房款#标题)买受人买受人=INDEX(销售买受人,售行)分区分区分期分期房号房号款类款类售序售序收据号码收据号码应收日应收日实收日实收日金额金额房类房类打款方式打款方式说明说明房行房行=MATCH(主房索引,主房主房索引,0)售行售行=MATCH(销售索引,销售销售索引,0)售次售次=INDEX(主房售次,房行)主房索引主房索引=$D$1&分期&TEXT(房号,0000000)销售索引销售索引=主房索引&售序款类索引款

7、类索引=销售索引&款类2汇总计算表，使用 VBA 进行原始数据合并和统计指标的计算。2.1 日报数据指标表（其他数据只是原始数据合并）标题名称标题名称含义项目分区分期范围状态说明开始日期=CHOOSE(LEFT(范围,1),TODAY()-2,EOMONTH(TODAY()-1,-1),DATE(YEAR(TODAY()-1),1,1)-1,40179)截至日期=CHOOSE(LEFT(范围,1),TODAY(),EOMONTH(TODAY()-1,0)+1,DATE(YEAR(TODAY()-1)+1,1,1),DATE(YEAR(TODAY()-1)+20,1,1)主房套数=COU

8、NTIFS(销售项目,项目,销售分区,分区,销售分期,分期,IF(状态=认购,销售认购日,IF(状态=签约,销售房约日,销售退房日),&开始日期)主房面积=SUMIFS(销售主房面积,销售项目,项目,销售分区,分区,销售分期,分期,IF(状态=认购,销售认购日,IF(状态=签约,销售房约日,销售退房日),&开始日期)应收=IF(状态=退房,0,SUMIFS(房款金额,房款款类,找差,房款登录项目,项目,房款分区,分区,房款分期,分期,房款状态,状态,房款应收日期,&开始日期,房款应收日期,&截至日期)+IF(状态=退房,0,SUMIFS(房款金额,房款款类,找差

9、,房款登录项目,项目,房款分区,分区,房款分期,分期,房款状态,状态,房款应收日期,&开始日期,房款实收日,)实收=SUMIFS(房款金额,房款款类,找差,房款登录项目,项目,房款分区,分区,房款分期,分期,房款状态,状态,房款实收日,&开始日期,房款实收日, TimeValue(YXJUZIUK) Then 如果不在凌晨打开 , 确认是否运行代码Ans = MsgBox(要进行数据运算吗?, vbYesNo, 请确认是否进行数据运算)If Ans = vbNo Then Exit SubEnd IfVltd(0) = 认购Vltd(1) = 签约Vltd(2) = 退房Ftw

10、w(0) = 1 本日Ftww(1) = 2 本月Ftww(2) = 3 本年Ftww(3) = 4 项目MyNamePath = 清除汇总计算工作簿原有数据For Each MySht In WorksheetsIf MySht.Name 基础 Then 如果不是基础表,清除原有数据MySht.Rows(2: & MySht.UsedRange.Rows.Count).DeleteEnd IfNext MySht清除完成逐个打开读入原始文件新数据Set ShtJC = ThisWorkbook.Sheets(基础)For Each MyRng In ShtJC.Range(原始数据文

11、件原始数据文件)Workbooks.Open MyRng.Value, 3, True, , , , True 只读方式打开原始数据文件ShtJC.Cells(MyRng.Row, 2) = FileDateTime(MyRng.Value) 记录原始文件的最终修改时间MyNamePath = ShtJC.Cells(MyRng.Row, 4) & 收款.xlsx无Workbooks.Open MyNamePath, 3, False, , , , True 读写方式打开对账工作簿With Workbooks(收款.xlsx).Sheets(房款).Rows(2: & .Use

12、dRange.Rows.Count).DeleteEnd WithThisWorkbook.ActivateFor Each MySht In WorksheetsMyRows = MySht.UsedRange.Rows.CountIf MySht.Name 基础 And MySht.Name 日报数据 ThenIf MySht.Cells(MyRows, 1) Then 表格后面无空行时添加一行MySht.Range(MySht.Name).ListObject.ListRows.AddAlwaysInsert:=TrueMyRows = MyRows + 1End If读入原始数据Wor

13、kbooks(销售数据.xlsm).Sheets(MySht.Name).Range(MySht.Name).CopyMySht.Cells(MyRows, 1).PasteSpecial Paste:=xlPasteValues, _Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseIf MySht.Name = 房款 ThenWorkbooks( 收 款 .xlsx).Sheets( 房 款 ).Cells(2, 1).PasteSpecialPaste:=xlPasteValues, _Operation:=xlNone,Skip

14、Blanks:=False,Transpose:=FalseWorkbooks(收款.xlsx).Close Savechanges:=TrueEnd If读入原始数据完成End IfNext MySht备份原始数据MyWordbookName=ShtJC.Cells(MyRng.Row,5)& 销 售 数 据 &Format(Day(Date), 00) & .xlsm 设置备份文件名称MyNamePath = ThisWorkbook.Path & 备份 & MyWordbookName 设置备份文件路径和名称Kill MyNamePathWorkb

15、ooks(销售数据.xlsm).SaveAs MyNamePathWorkbooks(MyWordbookName).Close Savechanges:=False 备份完成，关闭备份的文件Next MyRng 下一个原始数据文件完成原始数据读入形成日报数据With ShtJC ThisWorkbook.Sheets(基础)For Each MyRng In .Range(分期分期)遍历分期数据行无MyRow = MyRng.RowFor I = 0 To 3 范围(本日、本月、本年、项目）For J = 0 To 2 状态(0 认购 1 签约 2 退房）Set MySht = ThisWo

16、rkbook.Sheets(日报数据)If MySht.Cells(2, 1) Then 如果不是空表格就增加一个新空行MySht.Range(日报数据).ListObject.ListRows.AddAlwaysInsert:=TrueEnd IfMyRows = MySht.UsedRange.Rows.Count 记录表格最后一行以方便后面插入数据把数据写入日报数据表MySht.Cells(MyRows, 1) = .Cells(MyRow, 1) 写入项目名称MySht.Cells(MyRows, 2) = .Cells(MyRow, 2) 写入分区名称MySht.Cells(MyRo

17、ws, 3) = .Cells(MyRow, 3) 写入分期名称MySht.Cells(MyRows, 4) = Ftww(I) 写入范围MySht.Cells(MyRows, 5) = Vltd(J) 写入状态Next J 状态Next I 范围Next MyRng分期完成日报数据形成新的空表报文件Kill .Cells(2, 1) 删除原报表文件FileCopy .Cells(3, 1), .Cells(2, 1) 从模板复制出新文件Set MyWb = Workbooks.Open(ThisWorkbook.Sheets(基础).Cells(2, 1) 打开新文件End With Thi

18、sWorkbook.Sheets(基础)With MyWb.Sheets(销售日报).Cells(6, 2) = Date - 1 记录报表截至日期.Sheets(基础).Range(原始数据文件表最新版本日期).Value = _ShtJC.Range(原始数据文件最新版本日期).ValueFor Each MyRng In ShtJC.Range(数据工作表)If MyRng.Value = 基础 Then.Sheets(基础).Range(原始数据文件表最新版本日期).Value = _ShtJC.Range(原始数据文件最新版本日期).ValueElse.Sheets(MyRng.Va

19、lue).Range(MyRng.Value).Rows.DeleteThisWorkbook.Sheets(MyRng.Value).Range(MyRng.Value).Copy.Sheets(MyRng.Value).Cells(2,1).PasteSpecialPaste:=xlPasteValues,Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseEnd IfNext MyRng数据行,处理其他工作表无.RefreshAll 刷新表报.Save 保存新报表.sheeets(日报).Cells(1, 8).SelectApp

20、lication.ScreenUpdating = TrueApplication.DisplayAlerts = True 打开相响应和确认On Error GoTo 0If Time TimeValue(YXJUZIUK) Then.Close Savechanges:=True 退出报表ThisWorkbook.Close Savechanges:=True 退出本簿Application.QuitEnd IfEnd WithEnd Sub3表报，使用数据透视获得所有需要的数据成果3.1 总指标区期总指标区期总指标一小区一小区二小区二小区A A 区区B1B1 期期B2B2 期期居住区居住

21、区商业区商业区土地面积土地面积建筑面积建筑面积商品房套数商品房套数报表日期报表日期2016/11/13.2 销售统计总表范围范围状态状态主房套数主房套数主房面积主房面积应收款应收款实收款实收款欠收款欠收款1 1 本日本日认购19779,71110,00069,711签约004,925,416464,9874,460,429退房000002 2 本月本月认购19779,71110,00069,711签约005,404,406464,9874,939,419退房000003 3 本年本年认购52463,2343,494,9633,356,856138,107签约55667,211435,670,4

22、99428,291,3527,379,147退房45860-798,59104 4 项目项目认购1,534181,8614,073,9633,778,856295,107签约1,495177,3531,004,922,220995,181,4729,740,748退房571502,173,97703.3 项目销售统计表项目项目范围范围状态状态主房套主房套数数主房面积主房面积应收款应收款实收款实收款欠收款欠收款项项目目1 11 1 本日本日认购19779,71110,00069,711签约002,179,372464,9871,714,385退房000002 2 本月本月认购19779,7111

23、0,00069,711签约002,658,362464,9872,193,375无退房000003 3 本年本年认购35140,6103,454,9633,316,856138,107签约38044,325227,972,468223,309,3654,663,103退房000300,00004 4 项目项目认购950109,3253,733,9633,438,856295,107签约924106,701557,783,725550,789,0216,994,704退房0001,343,1370项项目目2 23.4 分区分期销售统计表项目项目 分区分区 分期分期 范围范围状态状态主房套主房套数数主房面主房面积积应收款应收款实收款实收款欠收款欠收款项项目目1 1A A01 1 本本日日认购000