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

1、利用Excel的VBA代码实现自动化“收集原始数据、汇总计算和报表”联系人：杨先生电话电子邮箱：以房地产销售数据为例。两个销售中心以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(房号,00000)，用于表间互查数据销售索引=IFERROR(主房索引&ABS(售序),) ，用于表间互查数据总房款已收待收1.2 销售表：每次销售活动的真实记录，产品的组合及从产品表查取的基本信息；标题名称含义售行

3、=ROW(主房)-ROW(销售#标题)分区名称分期名称手工输入数字（自定义格式）当前的销售次数，退房、换房不删除数据，所以用售次区别业务姓名置业顾问姓名合同中填写的总金额总款=ROUND(SUM(主房款,储款,库款,位款),0)，自动计算的总金额差异=总房款-总款主房面积=INDEX(主房面积,房行)认购日期=IFERROR(INDEX(房款实收日,MATCH(销售索引&定金,房款款类索引,0),)，实交定金日期主房款=ROUND(实售价*主房面积,0)购房合同签署日期合同单价贷款对象包含储藏室（C）、车库（K）等贷款资料合格日贷款合同签署日商放=SUMIFS(房款金额,房款销售索引,销售索引

4、,房款实收日,40544,房款款类,商贷)，商业贷款到账日公放=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,公贷)，公积金贷款到账日已收=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,找差)，不含找差待收=IF(售序0,总房款-已收,0)房行=MATCH(主房索引,主房主房索引,0)，对应产品表的行号主房索引=INDEX(项目分区代码,MATCH(房款!$B$1&分区,项目分区分区名称,0)&分期&TEXT(房号,0000000)销售索引=主房索引&ABS(售序)因业务换房造成本次销售无效时，记录换成了哪套房子1.3 房

5、款表：按合约应交、实交价款的信息标题名称含义款行=ROW(房款)-ROW(房款#标题)买受人=INDEX(销售买受人,售行)房行=MATCH(主房索引,主房主房索引,0)售行=MATCH(销售索引,销售销售索引,0)售次=INDEX(主房售次,房行)主房索引=$D$1&分期&TEXT(房号,0000000)销售索引=主房索引&售序款类索引=销售索引&款类2 汇总计算表，使用VBA进行原始数据合并和统计指标的计算。2.1 日报数据指标表（其他数据只是原始数据合并）标题名称含义项目分区分期范围状态说明开始日期=CHOOSE(LEFT(范围,1),TODAY()-2,EOMONTH(TODAY()-

6、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)主房套数=COUNTIFS(销售项目,项目,销售分区,分区,销售分期,分期,IF(状态=认购,销售认购日,IF(状态=签约,销售房约日,销售退房日),&开始日期)主房面积=SUMIFS(销售主房面积,销售项目,项目,销售分区,分区,销售分期,分期,IF(状态=认购,销售认购日,IF(状态=签约,销售

7、房约日,销售退房日),&开始日期)应收=IF(状态=退房,0,SUMIFS(房款金额,房款款类,找差,房款登录项目,项目,房款分区,分区,房款分期,分期,房款状态,状态,房款应收日期,&开始日期,房款应收日期,&截至日期)+IF(状态=退房,0,SUMIFS(房款金额,房款款类,找差,房款登录项目,项目,房款分区,分区,房款分期,分期,房款状态,状态,房款应收日期,&开始日期,房款实收日,)实收=SUMIFS(房款金额,房款款类,找差,房款登录项目,项目,房款分区,分区,房款分期,分期,房款状态,状态,房款实收日,&开始日期,房款实收日, TimeValue(YXJUZIUK) Then 如果

8、不在凌晨打开 , 确认是否运行代码 Ans = MsgBox(要进行数据运算吗?, vbYesNo, 请确认是否进行数据运算) If Ans = vbNo Then Exit Sub End If Vltd(0) = 认购 Vltd(1) = 签约 Vltd(2) = 退房 Ftww(0) = 1本日 Ftww(1) = 2本月 Ftww(2) = 3本年 Ftww(3) = 4项目 MyNamePath = 清除汇总计算工作簿原有数据 For Each MySht In Worksheets If MySht.Name 基础 Then 如果不是基础表,清除原有数据 MySht.Rows(2:

9、 & MySht.UsedRange.Rows.Count).Delete End If Next MySht 清除完成 逐个打开读入原始文件新数据 Set ShtJC = ThisWorkbook.Sheets(基础) For Each MyRng In ShtJC.Range(原始数据文件原始数据文件) Workbooks.Open MyRng.Value, 3, True, , , , True 只读方式打开原始数据文件 ShtJC.Cells(MyRng.Row, 2) = FileDateTime(MyRng.Value) 记录原始文件的最终修改时间 MyNamePath = Sht

10、JC.Cells(MyRng.Row, 4) & 收款.xlsx Workbooks.Open MyNamePath, 3, False, , , , True 读写方式打开对账工作簿 With Workbooks(收款.xlsx).Sheets(房款) .Rows(2: & .UsedRange.Rows.Count).Delete End With ThisWorkbook.Activate For Each MySht In Worksheets MyRows = MySht.UsedRange.Rows.Count If MySht.Name 基础 And MySht.Name 日报数

11、据 Then If MySht.Cells(MyRows, 1) Then 表格后面无空行时添加一行 MySht.Range(MySht.Name).ListObject.ListRows.Add AlwaysInsert:=True MyRows = MyRows + 1 End If 读入原始数据 Workbooks(销售数据.xlsm).Sheets(MySht.Name).Range(MySht.Name).Copy MySht.Cells(MyRows, 1).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBl

12、anks:=False, Transpose:=False If MySht.Name = 房款 Then Workbooks(收款.xlsx).Sheets(房款).Cells(2, 1).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False Workbooks(收款.xlsx).Close Savechanges:=True End If 读入原始数据完成 End If Next MySht 备份原始数据 MyWordbookName = ShtJC.Cells

13、(MyRng.Row, 5) & 销售数据 & Format(Day(Date), 00) & .xlsm 设置备份文件名称 MyNamePath = ThisWorkbook.Path & 备份 & MyWordbookName 设置备份文件路径和名称 Kill MyNamePath Workbooks(销售数据.xlsm).SaveAs MyNamePath Workbooks(MyWordbookName).Close Savechanges:=False 备份完成，关闭备份的文件 Next MyRng 下一个原始数据文件 完成原始数据读入 形成日报数据 With ShtJC ThisW

14、orkbook.Sheets(基础) For Each MyRng In .Range(分期分期) 遍历分期数据行 MyRow = MyRng.Row For I = 0 To 3 范围(本日、本月、本年、项目） For J = 0 To 2 状态(0认购1签约2退房） Set MySht = ThisWorkbook.Sheets(日报数据) If MySht.Cells(2, 1) Then 如果不是空表格就增加一个新空行 MySht.Range(日报数据).ListObject.ListRows.Add AlwaysInsert:=True End If MyRows = MySht.U

15、sedRange.Rows.Count 记录表格最后一行以方便后面插入数据 把数据写入日报数据表 MySht.Cells(MyRows, 1) = .Cells(MyRow, 1) 写入项目名称 MySht.Cells(MyRows, 2) = .Cells(MyRow, 2) 写入分区名称 MySht.Cells(MyRows, 3) = .Cells(MyRow, 3) 写入分期名称 MySht.Cells(MyRows, 4) = Ftww(I) 写入范围 MySht.Cells(MyRows, 5) = Vltd(J) 写入状态 Next J 状态 Next I 范围 Next MyR

16、ng 分期 完成日报数据 形成新的空表报文件 Kill .Cells(2, 1) 删除原报表文件 FileCopy .Cells(3, 1), .Cells(2, 1) 从模板复制出新文件 Set MyWb = Workbooks.Open(ThisWorkbook.Sheets(基础).Cells(2, 1) 打开新文件 End With ThisWorkbook.Sheets(基础) With MyWb .Sheets(销售日报).Cells(6, 2) = Date - 1 记录报表截至日期 .Sheets(基础).Range(原始数据文件表最新版本日期).Value = _ ShtJC

17、.Range(原始数据文件最新版本日期).Value For Each MyRng In ShtJC.Range(数据工作表) If MyRng.Value = 基础 Then .Sheets(基础).Range(原始数据文件表最新版本日期).Value = _ ShtJC.Range(原始数据文件最新版本日期).Value Else .Sheets(MyRng.Value).Range(MyRng.Value).Rows.Delete ThisWorkbook.Sheets(MyRng.Value).Range(MyRng.Value).Copy .Sheets(MyRng.Value).C

18、ells(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End If Next MyRng 数据行,处理其他工作表 .RefreshAll 刷新表报 .Save 保存新报表 .sheeets(日报).Cells(1, 8).Select Application.ScreenUpdating = True Application.DisplayAlerts = True 打开相响应和确认 On Error GoTo 0 If Time TimeVa

19、lue(YXJUZIUK) Then .Close Savechanges:=True 退出报表 ThisWorkbook.Close Savechanges:=True 退出本簿 Application.Quit End If End WithEnd Sub3 表报，使用数据透视获得所有需要的数据成果3.1 总指标2016/11/13.2 销售统计总表1本日认购1 97 79,711 10,000 69,711 签约0 0 4,925,416 464,987 4,460,429 退房0 0 0 0 0 2本月认购1 97 79,711 10,000 69,711 签约0 0 5,404,40

20、6 464,987 4,939,419 退房0 0 0 0 0 3本年认购524 63,234 3,494,963 3,356,856 138,107 签约556 67,211 435,670,499 428,291,352 7,379,147 退房4 586 0 -798,591 0 4项目认购1,534 181,861 4,073,963 3,778,856 295,107 签约1,495 177,353 1,004,922,220 995,181,472 9,740,748 退房5 715 0 2,173,977 0 3.3 项目销售统计表项目11本日认购1 97 79,711 10,0

21、00 69,711 签约0 0 2,179,372 464,987 1,714,385 退房0 0 0 0 0 2本月认购1 97 79,711 10,000 69,711 签约0 0 2,658,362 464,987 2,193,375 退房0 0 0 0 0 3本年认购351 40,610 3,454,963 3,316,856 138,107 签约380 44,325 227,972,468 223,309,365 4,663,103 退房0 0 0 300,000 0 4项目认购950 109,325 3,733,963 3,438,856 295,107 签约924 106,701 557,783,725 550,789,021 6,994,704 退房0 0 0 1,343,137 0 项目23.4 分区分期销售统计表项目1A01本日认购0 0 0 0 0 签约0 0 684,398 0 684,398 退房0 0 0 0 0 2本月认购0 0 0 0 0 签约0 0 684,398 0 684,398 退房0 0 0 0 0 3本年认购57 8,846 500,000 500,000 0 签约63