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

-.z.利用E*cel的VBA代码实现自动化"收集原始数据、汇总计算和报表”联系人：杨先生：电子邮箱：yjjp67163.以房地产销售数据为例。两个销售中心以E*cel记录销售活动，原始数据和直接使用公式形成的表格模板如下。黄色标题名称为公式项，根据已知数据自动计算。原始数据收集表产品表：所有房屋产品，主房、辅房（储藏室、车库、车位等）的基本信息；标题名称含义房行=ROW(主房[])-ROW(主房[#标题])，动态的数据行号买受人=IFERROR(INDE*(销售[买受人],[售行]),"")，当前买受人项目销售项目名称分区分区名称分期分期名称楼数字楼号单数字单元号层数字楼层房数字方位编号面积预售面积预售价预售价格产权产权面积售次=COUNTIFS(销售[主房索引],[主房索引])，当前的销售次数，退房、换房不删除数据，所以用售次区别售行对应的销售数据行。房号=VALUE([单]&TE*T([层],"00")&TE*T([房],"00"))，如1单元1层东户表示为1-0101（数字的自定义格式）主房索引=INDE*(项目分区[代码],MATCH([项目]&[分区],项目分区[分区名称],0))&[分期]&TE*T([楼],"00")&TE*T([房号],"00000")，用于表间互查数据销售索引=IFERROR([主房索引]&ABS([售序]),"")，用于表间互查数据总房款已收待收销售表：每次销售活动的真实记录，产品的组合及从产品表查取的基本信息；标题名称含义售行=ROW(主房[])-ROW(销售[#标题])分区分区名称分期分期名称房号手工输入数字（自定义格式）售序当前的销售次数，退房、换房不删除数据，所以用售次区别买受人业务姓名顾问置业顾问姓名实售价储号储款库号库款位号位款总房款合同中填写的总金额总款=ROUND(SUM([主房款],[储款],[库款],[位款]),0)，自动计算的总金额差异=[总房款]-[总款]主房面积=INDE*(主房[面积],[房行])认购日期=IFERROR(INDE*(房款[实收日],MATCH([销售索引]&"定金",房款[款类索引],0)),"")，实交定金日期主房款=ROUND([实售价]*[主房面积],0)房约日购房合同签署日期房约价合同单价买受人身份证号共有人共有人身份证号合同交房日贷行贷含贷款对象包含储藏室（C）、车库（K）等贷额公贷资料日贷款资料合格日贷约日贷款合同签署日商放=SUMIFS(房款[金额],房款[销售索引],[销售索引],房款[实收日],">40544",房款[款类],"商贷")，商业贷款到账日公放=SUMIFS(房款[金额],房款[销售索引],[销售索引],房款[实收日],">40544",房款[款类],"公贷")，公积金贷款到账日已收=SUMIFS(房款[金额],房款[销售索引],[销售索引],房款[实收日],">40544",房款[款类],"<>找差")，不含找差待收=IF([售序]>0,[总房款]-[已收],0)房行=MATCH([主房索引],主房[主房索引],0)，对应产品表的行号主房索引=INDE*(项目分区[代码],MATCH(房款!$B$1&[分区],项目分区[分区名称],0))&[分期]&TE*T([房号],"0000000")销售索引=[主房索引]&ABS([售序])换房因业务换房造成本次销售无效时，记录换成了哪套房子房款表：按合约应交、实交价款的信息标题名称含义款行=ROW(房款[])-ROW(房款[#标题])买受人=INDE*(销售[买受人],[售行])分区分期房号款类售序收据号码应收日实收日金额房类打款方式说明房行=MATCH([主房索引],主房[主房索引],0)售行=MATCH([销售索引],销售[销售索引],0)售次=INDE*(主房[售次],[房行])主房索引=$D$1&[分期]&TE*T([房号],"0000000")销售索引=[主房索引]&[售序]款类索引=[销售索引]&[款类]汇总计算表，使用VBA进行原始数据合并和统计指标的计算。日报数据指标表（其他数据只是原始数据合并）标题名称含义项目分区分期范围状态说明开始日期=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,[应收]-[实收])VBA代码PrivateSubWorkbook_Open()ConstY*JUZIUKAsString="05:00:00"'设置自动运行结束最迟时刻DimMyWbAsWorkbook'打开的工作表（原始数据和报表）DimMySht,ShtJCAsWorksheet'打开工作薄的指定工作表和本工作簿的指定工作表DimMyTb,ThisTbAsListObject'打开工作薄的指定表格和本工作簿的指定表格DimMyRngAsRangeDimMyNamePath,Vltd(3),Ftww(4)AsStringDimMyRow,MyRows,MyRngR,MyRngC,I,J,AnsAsLongOnErrorResumeNe*t'出现错误不提示,直接运行下一行代码Application.ScreenUpdating=False'关闭屏幕刷新Application.DisplayAlerts=False'关闭相应和确认IfTime>TimeValue(Y*JUZIUK)Then'如果不在凌晨打开,确认是否运行代码Ans=MsgBo*("要进行数据运算吗"",vbYesNo,"请确认是否进行数据运算")IfAns=vbNoThenE*itSubEndIfVltd(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).DeleteEndIfNe*tMySht'清除完成'逐个打开读入原始文件新数据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)&"\收款.*ls*"Workbooks.OpenMyNamePath,3,False,,,,True'读写方式打开对账工作簿WithWorkbooks("收款.*ls*").Sheets("房款").Rows("2:"&.UsedRange.Rows.Count).DeleteEndWithThisWorkbook.ActivateForEachMyShtInWorksheetsIfMySht.Name<>"基础"AndMySht.Name<>"日报数据"ThenIfMySht.Cells(MyRows,1)>""Then'表格后面无空行时添加一行MySht.Range(MySht.Name).ListObject.ListRows.AddAlwaysInsert:=TrueMyRows=MyRows+1EndIf'读入原始数据Workbooks("销售数据.*lsm").Sheets(MySht.Name).Range(MySht.Name).CopyMySht.Cells(MyRows,1).PasteSpecialPaste:=*lPasteValues,_Operation:=*lNone,SkipBlanks:=False,Transpose:=FalseIfMySht.Name="房款"ThenWorkbooks("收款.*ls*").Sheets("房款").Cells(2,1).PasteSpecialPaste:=*lPasteValues,_Operation:=*lNone,SkipBlanks:=False,Transpose:=FalseWorkbooks("收款.*ls*").CloseSavechanges:=TrueEndIf'读入原始数据完成EndIfNe*tMySht'备份原始数据MyWordbookName=ShtJC.Cells(MyRng.Row,5)&"销售数据"&Format(Day(Date),"00")&".*lsm"'设置备份文件名称MyNamePath=ThisWorkbook.Path&"\备份\"&MyWordbookName'设置备份文件路径和名称KillMyNamePathWorkbooks("销售数据.*lsm").SaveAsMyNamePathWorkbooks(MyWordbookName).CloseSavechanges:=False'备份完成，关闭备份的文件Ne*tMyRng'下一个原始数据文件'完成原始数据读入'形成日报数据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'记录表格最后一行以方便后面插入数据'把数据写入日报数据表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)'写入状态Ne*tJ'状态Ne*tI'范围Ne*tMyRng'分期'完成日报数据'形成新的空表报文件Kill.Cells(2,1)'删除原报表文件FileCopy.Cells(3,1),.Cells(2,1)'从模板复制出新文件SetMyWb=Workbooks.Open(ThisWorkbook.Sheets("基础").Cells(2,1))'打开新文件EndWith'ThisWorkbook.Sheets("基础")WithMyWb.Sheets("销售日报").Cells(6,2)=Date-1'记录报表截至日期.Sheets("基础").Range("原始数据文件表[最新版本日期]").Value=_ShtJC.Range("原始数据文件[最新版本日期]").ValueForEachMyRngInShtJC.Range("数据工作表")IfMyRng.Value="基础"Then.Sheets("基础").Range("原始数据文件表[最新版本日期]").Value=_ShtJC.Range("原始数据文件[最新版本日期]").ValueElse'.Sheets(MyRng.Value).Range(MyRng.Value).Rows.DeleteThisWorkbook.Sheets(MyRng.Value).Range(MyRng.Value).Copy.Sheets(MyRng.Value).Cells(2,1).PasteSpecialPaste:=*lPasteValues,Operation:=*lNone,_SkipBlanks:=False,Transpose:=FalseEndIfNe*tMyRng'数据行,处理其他工作表.RefreshAll'刷新表报.Save'保存新报表.sheeets("日报").Cells(1,8).SelectApplication.ScreenUpdating=TrueApplication.DisplayAlerts=True'打开相响应和确认OnErrorGoTo0IfTime<TimeValue(Y*JUZIUK)Then.CloseSavechanges:=True'退出报表ThisWorkbook.CloseSavechanges:=True'退出本簿Application.QuitEndIfEndWithEndSub表报，使用数据透视获得所有需要的数据成果总指标区期总指标一小区二小区A区B1期B2期居住区商业区土地面积建筑面积商品房套数报表日期2016/11/1销售统计总表范围状态主房套数主房面积应收款实收款欠收款1本日认购19779,71110,00069,711签约004,925,416464,9874,460,429退房000002本月认购19779,71110,00069,711签约005,404,406464,9874,939,419退房000003本年认购52463,2343,494,9633,356,856138,107签约55667,211435,670,499428,291,3527,379,147退房45860-798,59104项目认购1,534181,8614,073,9633,778,856295,107签约1,495177,3531,004,922,220995,181,4729,740,748退房571502,173,9770项目销售统计表项目范围状态主房套数主房面积应收款实收款欠收款项目11本日认购19779,71110,00069,711签约002,179,372464,9871,714,385退房000002本月认购19779,71110,00069,711签约002,658,362464,9872,193,375退房000003本年认购35140,6103,454,9633,316,856138,107签约38044,325227,972,468223,309,3654,663,103退房000300,00004项目认购950109,3253,733,9633,438,856295,107签约924106,701557,783,725550,789,0216,994,704退房0001,343,1370项目2分区分期销售统计表项目分区分期范围状态主房套数主房面积应收款实收款欠收款项目1A01本日认购00000签约00684,3980684,398退房000002本月认购00000签约00684,3980684,398/r