搜索
利用Excel的VBA代码实现自动化“收集原始数据、汇总计算和报表”联系人：杨先生电话：18053150391电子邮箱：yjjp67@163.com以房地产销售数据为例。两个销售中心以Excel记录销售活动，原始数据和直接使用公式形成的表格模板如下。黄色标题名称为公式项，根据已知数据自动计算。1原始数据收集表1.1产品表：所有房屋产品，主房、辅房（储藏室、车库、车位等）的基本信息；标题名称含义房行=ROW(主房[@])-ROW(主房[#标题])，动态的数据行号买受人=IFERROR(INDEX(销售[买受人],[@售行]),)，当前买受人项目销售项目名称分区分区名称分期分期名称楼数字楼号单数字单元号层数字楼层房数字方位编号面积预售面积预售价预售价格产权产权面积售次=COUNTIFS(销售[主房索引],[@主房索引])，当前的销售次数，退房、换房不删除数据，所以用售次区别售行对应的销售数据行。房号=VALUE([@单]&TEXT([@层],00)&TEXT([@房],00))，如1单元1层东户表示为1-0101（数字的自定义格式）主房索引=INDEX(项目分区[代码],MATCH([@项目]&[@分区],项目分区[分区名称],0))&[@分期]&TEXT([@楼],00)&TEXT([@房号],00000)，用于表间互查数据销售索引=IFERROR([@主房索引]&ABS([@售序]),)，用于表间互查数据总房款已收待收1.2销售表：每次销售活动的真实记录，产品的组合及从产品表查取的基本信息；标题名称含义售行=ROW(主房[@])-ROW(销售[#标题])分区分区名称分期分期名称房号手工输入数字（自定义格式）售序当前的销售次数，退房、换房不删除数据，所以用售次区别买受人业务姓名顾问置业顾问姓名实售价储号储款库号库款位号位款总房款合同中填写的总金额总款=ROUND(SUM([@主房款],[@储款],[@库款],[@位款]),0)，自动计算的总金额差异=[@总房款]-[@总款]主房面积=INDEX(主房[面积],[@房行])认购日期=IFERROR(INDEX(房款[实收日],MATCH([@销售索引]&定金,房款[款类索引],0)),)，实交定金日期主房款=ROUND([@实售价]*[@主房面积],0)房约日购房合同签署日期房约价合同单价买受人身份证号共有人共有人身份证号合同交房日贷行贷含贷款对象包含储藏室（C）、车库（K）等贷额公贷资料日贷款资料合格日贷约日贷款合同签署日商放=SUMIFS(房款[金额],房款[销售索引],[@销售索引],房款[实收日],40544,房款[款类],商贷)，商业贷款到账日公放=SUMIFS(房款[金额],房款[销售索引],[@销售索引],房款[实收日],40544,房款[款类],公贷)，公积金贷款到账日已收=SUMIFS(房款[金额],房款[销售索引],[@销售索引],房款[实收日],40544,房款[款类],找差)，不含找差待收=IF([@售序]0,[@总房款]-[@已收],0)房行=MATCH([@主房索引],主房[主房索引],0)，对应产品表的行号主房索引=INDEX(项目分区[代码],MATCH(房款!$B$1&[@分区],项目分区[分区名称],0))&[@分期]&TEXT([@房号],0000000)销售索引=[@主房索引]&ABS([@售序])换房因业务换房造成本次销售无效时，记录换成了哪套房子1.3房款表：按合约应交、实交价款的信息标题名称含义款行=ROW(房款[@])-ROW(房款[#标题])买受人=INDEX(销售[买受人],[@售行])分区分期房号款类售序收据号码应收日实收日金额房类打款方式说明房行=MATCH([@主房索引],主房[主房索引],0)售行=MATCH([@销售索引],销售[销售索引],0)售次=INDEX(主房[售次],[@房行])主房索引=$D$1&[@分期]&TEXT([@房号],0000000)销售索引=[@主房索引]&[@售序]款类索引=[@销售索引]&[@款类]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(销售[项目],[@项目],销售[分区],[@分区],销售[分期],[@分期],IF([@状态]=认购,销售[认购日],IF([@状态]=签约,销售[房约日],销售[退房日])),&[@开始日期])主房面积=SUMIFS(销售[主房面积],销售[项目],[@项目],销售[分区],[@分区],销售[分期],[@分期],IF([@状态]=认购,销售[认购日],IF([@状态]=签约,销售[房约日],销售[退房日])),&[@开始日期])应收=IF([@状态]=退房,0,SUMIFS(房款[金额],房款[款类],找差,房款[登录项目],[@项目],房款[分区],[@分区],房款[分期],[@分期],房款[状态],[@状态],房款[应收日期],&[@开始日期],房款[应收日期],&[@截至日期]))+IF([@状态]=退房,0,SUMIFS(房款[金额],房款[款类],找差,房款[登录项目],[@项目],房款[分区],[@分区],房款[分期],[@分期],房款[状态],[@状态],房款[应收日期],&[@开始日期],房款[实收日],))实收=SUMIFS(房款[金额],房款[款类],找差,房款[登录项目],[@项目],房款[分区],[@分区],房款[分期],[@分期],房款[状态],[@状态],房款[实收日],&[@开始日期],房款[实收日],&[@截至日期])欠收=IF([@状态]=退房,0,[@应收]-[@实收])2.2VBA代码PrivateSubWorkbook_Open()ConstYXJUZIUKAsString=05:00:00'设置自动运行结束最迟时刻DimMyWbAsWorkbook'打开的工作表（原始数据和报表）DimMySht,ShtJCAsWorksheet'打开工作薄的指定工作表和本工作簿的指定工作表DimMyTb,ThisTbAsListObject'打开工作薄的指定表格和本工作簿的指定表格DimMyRngAsRangeDimMyNamePath,Vltd(3),Ftww(4)AsStringDimMyRow,MyRows,MyRngR,MyRngC,I,J,AnsAsLongOnErrorResumeNext'出现错误不提示,直接运行下一行代码Application.ScreenUpdating=False'关闭屏幕刷新Application.DisplayAlerts=False'关闭相应和确认IfTimeTimeValue(YXJUZIUK)Then'如果不在凌晨打开,确认是否运行代码Ans=MsgBox(要进行数据运算吗?,vbYesNo,请确认是否进行数据运算)IfAns=vbNoThenExitSubEndIfVltd(0)=认购Vltd(1)=签约Vltd(2)=退房Ftww(0)=1本日Ftww(1)=2本月Ftww(2)=3本年Ftww(3)=4项目MyNamePath='清除汇总计算工作簿原有数据ForEachMyShtInWorksheetsIfMySht.Name基础Then'如果不是基础表,清除原有数据MySht.Rows(2:&MySht.UsedRange.Rows.Count).DeleteEndIfNextMySht'清除完成'逐个打开读入原始文件新数据SetShtJC=ThisWorkbook.Sheets(基础)ForEachMyRngInShtJC.Range(原始数据文件[原始数据文件])Workbooks.OpenMyRng.Value,3,True,,,,True'只读方式打开原始数据文件ShtJC.Cells(MyRng.Row,2)=FileDateTime(MyRng.Value)'记录原始文件的最终修改时间MyNamePath=ShtJC.Cells(MyRng.Row,4)&\收款.xlsxWorkbooks.OpenMyNamePath,3,False,,,,True'读写方式打开对账工作簿WithWorkbooks(收款.xlsx).Sheets(房款).Rows(2:&.UsedRange.Rows.Count).DeleteEndWithThisWorkbook.ActivateForEachMyShtInWorksheetsMyRows=MySht.UsedRange.Rows.CountIfMySht.Name基础AndMySht.Name日报数据ThenIfMySht.Cells(MyRows,1)Then'表格后面无空行时添加一行MySht.Range(MySht.Name).ListObject.ListRows.AddAlwaysInsert:=TrueMyRows=MyRows+1EndIf'读入原始数据Workbooks(销售数据.xlsm).Sheets(MySht.Name).Range(MySht.Name).CopyMySht.Cells(MyRows,1).PasteSpecialPaste:=xlPasteValues,_Operation:=xlNone,SkipBlanks:=False,Transpose:=FalseIfMySht.Name=房款ThenWorkbooks(收款.xlsx).Sheets(房款).Cells(2,1).PasteSpecialPaste:=xlPasteValues,_Operation:=xlNone,SkipBlanks:=False,Transpose:=FalseWorkbooks(收款.xlsx).CloseSavechanges:=TrueEndIf'读入原始数据完成EndIfNextMySht'备份原始数据MyWordbookName=ShtJC.Cells(MyRng.Row,5)&销售数据&Format(Day(Date),00)&.xlsm'设置备份文件名称MyNamePath=ThisWorkbook.Path&\备份\&MyWordbookName'设置备份文件路径和名称KillMyNamePathWorkbooks(销售数据.xlsm).SaveAsMyNamePathWorkbooks(MyWordbookName).CloseSavechanges:=False'备份完成，关闭备份的文件NextMyRng'下一个原始数据文件'完成原始数据读入'形成日报数据WithShtJC'ThisWorkbook.Sheets(基础)ForEachMyRngIn.Range(分期[分期])'遍历分期数据行MyRow=MyRng.RowForI=0To3'范围(本日、本月、本年、项目）ForJ=0To2'状态(0认购1签约2退房）SetMySht=ThisWorkbook.Sheets(日报数据)IfMySht.Cells(2,1)Then'如果不是空表格就增加一个新空行MySht.Range(日报数据).ListObject.ListRows.AddAlwaysInsert:=TrueEndIfMyRows=MySht.UsedRange.Rows.Count'记录表格最后一行以方便后面插入