利用excel的vba代码实现自动化收集原始数据汇总计算和报表.docx

1、利用excel的vba代码实现自动化收集原始数据汇总计算和报表利用Excel的VBA代码实现自动化“收集原始数据、汇总计算和报表”联系人：杨先生 ： 电子邮箱：yjjp67163.以房地产销售数据为例。两个销售中心以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)房约日购房合同签署日

4、期房约价合同单价买受人身份证号共有人共有人身份证号合同交房日贷行贷含贷款对象包含储藏室（C）、车库（K）等贷额公贷资料日贷款资料合格日贷约日贷款合同签署日商放=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,商贷)，商业贷款到账日公放=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,公贷)，公积金贷款到账日已收=SUMIFS(房款金额,房款销售索引,销售索引,房款实收日,40544,房款款类,找差)，不含找差待收=IF(售序0,总房款-已收,0)房行=MATCH(主房索引,主房主房索引,0)，对应产品表的行号主房索引=INDE

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

6、款类索引=销售索引&款类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)主房套数=COUNTIFS(销售项目

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

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

9、ww(2) = 3本年 Ftww(3) = 4项目 MyNamePath = 清除汇总计算工作簿原有数据 For Each MySht In Worksheets If MySht.Name 基础 Then 如果不是基础表,清除原有数据 MySht.Rows(2: & MySht.UsedRange.Rows.Count).Delete End If Next MySht 清除完成 逐个打开读入原始文件新数据 Set ShtJC = ThisWorkbook.Sheets(基础) For Each MyRng In ShtJC.Range(原始数据文件原始数据文件) Workbooks.Ope

10、n 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: & .UsedRange.Rows.Count).Delete

11、 End With ThisWorkbook.Activate For Each MySht In Worksheets MyRows = MySht.UsedRange.Rows.Count If MySht.Name 基础 And MySht.Name 日报数据 Then If MySht.Cells(MyRows, 1) Then 表格后面无空行时添加一行 MySht.Range(MySht.Name).ListObject.ListRows.Add AlwaysInsert:=True MyRows = MyRows + 1 End If 读入原始数据 Workbooks(销售数据.x

12、lsm).Sheets(MySht.Name).Range(MySht.Name).Copy MySht.Cells(MyRows, 1).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=False, Transpose:=False If MySht.Name = 房款 Then Workbooks(收款.xlsx).Sheets(房款).Cells(2, 1).PasteSpecial Paste:=xlPasteValues, _ Operation:=xlNone, SkipBlanks:=Fals

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

14、eAs MyNamePath Workbooks(MyWordbookName).Close Savechanges:=False 备份完成，关闭备份的文件 Next MyRng 下一个原始数据文件 完成原始数据读入 形成日报数据 With ShtJC ThisWorkbook.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(

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

16、) = .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 W

17、ith ThisWorkbook.Sheets(基础) With MyWb .Sheets(销售日报).Cells(6, 2) = Date - 1 记录报表截至日期 .Sheets(基础).Range(原始数据文件表最新版本日期).Value = _ ShtJC.Range(原始数据文件最新版本日期).Value For Each MyRng In ShtJC.Range(数据工作表) If MyRng.Value = 基础 Then .Sheets(基础).Range(原始数据文件表最新版本日期).Value = _ ShtJC.Range(原始数据文件最新版本日期).Value Else

18、 .Sheets(MyRng.Value).Range(MyRng.Value).Rows.Delete ThisWorkbook.Sheets(MyRng.Value).Range(MyRng.Value).Copy .Sheets(MyRng.Value).Cells(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _ SkipBlanks:=False, Transpose:=False End If Next MyRng 数据行,处理其他工作表 .RefreshAll 刷新表报 .Save 保存新报表 .sheee

19、ts(日报).Cells(1, 8).Select Application.ScreenUpdating = True Application.DisplayAlerts = True 打开相响应和确认 On Error GoTo 0 If Time TimeValue(YXJUZIUK) Then .Close Savechanges:=True 退出报表 ThisWorkbook.Close Savechanges:=True 退出本簿 Application.Quit End If End WithEnd Sub3表报，使用数据透视获得所有需要的数据成果3.1总指标区期总指标一小区二小区

20、A区B1期B2期居住区商业区土地面积建筑面积商品房套数报表日期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,406 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

21、,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,000 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

22、 签约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分区分期销售统计表项目分区分期范围状态主房套数主房

23、面积应收款实收款欠收款项目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 9,665 51,521,928 50,253,530 1,268,398 退房0 0 0 0 0 4项目认购511 61,413 562,000 562,000 0 签约511 61,414 352,571,621 351,083,223 1,488,398 退房0 0 0 811,54

24、7 0 B11本日认购1 97 79,711 10,000 69,711 签约0 0 1,494,974 464,987 1,029,987 退房0 0 0 0 0 2本月认购1 97 79,711 10,000 69,711 签约0 0 1,973,964 464,987 1,508,977 退房0 0 0 0 0 3本年认购294 31,764 2,954,963 2,816,856 138,107 签约317 34,660 176,450,540 173,055,835 3,394,705 退房0 0 0 300,000 0 4项目认购439 47,911 3,171,963 2,876,856 295,107 签约413 45,287 205,212,104 199,705,798 5,506,306 退房0 0 0 531,590 0 4网络拓扑4.1原始数据4.1.1人工报送：定时拷贝报送，优盘、点对点传输（