利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx
《利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx》由会员分享，可在线阅读，更多相关《利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx（19页珍藏版）》请在冰点文库上搜索。
利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表
利用Exceｌ得VBA代码实现自动化ﻫ“收集原始数据、汇总计算与报表”
联系人:
杨先生ﻩ电话:
电子邮箱:
以房地产销售数据为例.
两个销售中心以Eｘcel记录销售活动,原始数据与直接使用公式形成得表格模板如下。
黄色标题名称为公式项，根据已知数据自动计算。
1原始数据收集表
1.1产品表：
所有房屋产品，主房、辅房（储藏室、车库、车位等）得基本信息；
标题名称
含义
房行
＝ROW（主房[］）-RＯW（主房[＃标题］），动态得数据行号
买受人
＝IFERROR（INDEX（销售[买受人],[售行］）,"＂），当前买受人
销售项目名称
分区名称
分期名称
数字楼号
数字单元号
数字楼层
数字方位编号
预售面积
预售价格
产权面积
售次
=CＯUNＴIＦＳ（销售［主房索引],[主房索引］），当前得销售次数,退房、换房不删除数据，所以用售次区别
售行
对应得销售数据行。
房号
=VALＵＥ（[单］&TEXT（[层］，"０0”）&TＥXT（［房］，"0０”）），如1单元1层东户表示为1－０101（数字得自定义格式）
主房索引
＝ＩＮDEＸ（项目分区［代码］,MATCH（［项目］＆［分区］，项目分区[分区名称],０））＆[分期］&ＴEＸT（[楼]，”00＂）&TEＸT（[房号］，＂00000”）,用于表间互查数据
销售索引
=IFＥRROＲ（［主房索引］&ＡBＳ（[售序]）,＂＂）,用于表间互查数据
总房款
已收
待收
1.2销售表:
每次销售活动得真实记录，产品得组合及从产品表查取得基本信息;
标题名称
含义
售行
=ROW（主房[］）－ROW（销售［#标题]）
分区名称
分期名称
手工输入数字（自定义格式）
当前得销售次数，退房、换房不删除数据,所以用售次区别
业务姓名
置业顾问姓名
合同中填写得总金额
总款
＝ROUND（ＳUM（［主房款],［储款］,［库款],［位款］），0），自动计算得总金额
差异
=[总房款]—［总款］
主房面积
＝INDＥX（主房［面积］,［房行］）
认购日期
=IＦEＲRＯR（ＩＮDEＸ（房款［实收日]，MATCH（［销售索引］＆＂定金",房款［款类索引］,0））,"”）,实交定金日期
主房款
＝ROUND（［实售价］＊［主房面积],0）
购房合同签署日期
合同单价
贷款对象包含储藏室（C）、车库（K）等
贷款资料合格日
贷款合同签署日
商放
＝SＵMＩFS（房款［金额］，房款［销售索引］，［销售索引］，房款［实收日]，">４０54４”，房款［款类］,"商贷＂），商业贷款到账日
公放
＝ＳUMIFS（房款[金额］，房款［销售索引],[销售索引］，房款[实收日］，”〉４0544”，房款[款类],"公贷”），公积金贷款到账日
已收
=SＵMIＦS（房款[金额］，房款[销售索引］,［销售索引]，房款[实收日],”＞4０544"，房款[款类],"<>找差”），不含找差
待收
=IＦ（[售序]〉０，[总房款］－[已收],０）
房行
=ＭAＴCＨ（[主房索引]，主房[主房索引］，0），对应产品表得行号
主房索引
＝ＩNDEX（项目分区［代码]，ＭＡＴＣＨ（房款！
＄B＄1&［分区］,项目分区［分区名称]，0））&[分期]&TＥXT（[房号]，”0０00０00"）
销售索引
＝［主房索引]＆ＡBS（［售序］）
因业务换房造成本次销售无效时，记录换成了哪套房子
1.3房款表:
按合约应交、实交价款得信息
标题名称
含义
款行
=ROＷ（房款[］）-ROＷ（房款［#标题］）
买受人
=INDEＸ（销售[买受人]，［售行］）
房行
=MATCH（[主房索引］,主房[主房索引]，０）
售行
＝MＡＴCH（[销售索引]，销售［销售索引］，0）
售次
=INDEX（主房[售次］,[房行］）
主房索引
＝＄Ｄ＄１＆［分期]&TEXT（［房号］，"00000０0＂）
销售索引
＝[主房索引］＆[售序]
款类索引
＝［销售索引］&［款类]
2汇总计算表，使用VBA进行原始数据合并与统计指标得计算。
2.1日报数据指标表（其她数据只就是原始数据合并）
标题名称
含义
项目
分区
分期
范围
状态
说明
开始日期
=ＣHOOＳE（LEＦT（[范围］,１），ＴＯＤAY（）-2，EOMONTH（TOＤAY（）—1,—1），DATE（YEＡＲ（TOＤAY（）－１），1，１）—1,4017９）
截至日期
＝CＨOOSE（LEFT（［范围],１）,TＯＤＡY（）,EOＭONTH（TＯＤAY（）－1，0）+1,DATE（YEAR（TＯDAＹ（）-1）＋1,1,１）,DATE（ＹEＡＲ（TODAY（）-1）+20,1,1））
主房套数
=COUＮＴIＦＳ（销售[项目］，[项目]，销售［分区］，［分区］,销售［分期］，［分期]，IF（［状态]＝”认购”，销售[认购日],IF（[状态］＝”签约”，销售［房约日］，销售［退房日］））,”>”&［开始日期］）
主房面积
＝ＳUＭIＦS（销售[主房面积］，销售[项目］，[项目］，销售[分区]，[分区]，销售[分期］，［分期],ＩF（［状态］=”认购"，销售［认购日]，IF（［状态]＝”签约＂，销售[房约日］，销售［退房日]）），”＞"＆［开始日期］）
应收
=ＩＦ（[状态］＝"退房"，0,SUMＩFS（房款［金额］,房款[款类］,”<＞找差"，房款［登录项目］，［项目］，房款［分区］，[分区］，房款［分期]，[分期]，房款[状态],[状态］，房款[应收日期],"〉”＆[开始日期］，房款[应收日期］,"<"＆［截至日期]））+ＩF（[状态］＝"退房”,0，SＵMIFS（房款[金额］,房款［款类］，"〈>找差”，房款[登录项目］，[项目］，房款[分区],[分区]，房款［分期]，［分期]，房款[状态］，[状态],房款[应收日期]，＂＜"&［开始日期]，房款［实收日］，””））
实收
＝SＵＭIＦS（房款［金额］，房款［款类],＂〈>找差”,房款［登录项目］，［项目]，房款[分区］,[分区］,房款［分期]，［分期]，房款[状态],［状态],房款［实收日］，”〉"＆［开始日期]，房款[实收日]，"<"&［截至日期]）
欠收
=IF（[状态］="退房”，0，［应收]-［实收］）
2.2VＢＡ代码
PrivatｅSubＷｏｒkboｏk_Ｏｐen（）
ＣｏnstYXJＵZIＵＫAsStriｎg=”05:
00：
00＂'设置自动运行结束最迟时刻
DimMyWb AsWorkboｏk’打开得工作表（原始数据与报表）
Diｍ ＭySht,ＳhｔＪＣAsWｏｒkｓhｅｅt’打开工作薄得指定工作表与本工作簿得指定工作表
DiｍＭyTb,ThisTbAｓListＯbject'打开工作薄得指定表格与本工作簿得指定表格
DimMｙRngAsＲａngｅ
DｉmMｙNamePaｔh， Vlｔd（3）, Ftww（4） ＡsＳｔrｉng
Dim MｙRｏw，ＭyRｏｗs，MyRｎgＲ，MyRngＣ,I, J,ＡｎsAsLｏng
OnErroｒResｕme Nｅxｔ＇出现错误不提示,直接运行下一行代码
Aｐplicaｔｉｏn、ScｒeenＵpdatiｎg =Faｌsｅ '关闭屏幕刷新
Apｐlｉcatiｏn、ＤiｓｐｌａyAleｒｔs=False'关闭相应与确认
IfTｉｍe〉TiｍeValue（YXJUZＩUＫ）Ｔhen＇如果不在凌晨打开 ,确认就是否运行代码
Aｎs=ＭsgＢoｘ（"要进行数据运算吗？
＂,vbYesNo， ＂请确认就是否进行数据运算"）
IfAns =vbNｏTｈenExｉtSuｂ
EndIf
Vltd（０）= ”认购＂
Ｖlｔｄ
（1）="签约"
Vltd
（2） =＂退房”
Ftww（0）=”１本日"
Ｆtww
（1）＝＂2本月"
Fｔｗw（２）= ＂3本年”
Ftww（３） =”4项目”
MyNamePath= ”"
＇清除汇总计算工作簿原有数据
FoｒEａchMyＳhｔＩnWorｋｓheetｓ
ＩfMySht、Ｎame〈＞ ＂基础"Ｔhｅｎ'如果不就是基础表，清除原有数据
MｙSht、Ｒows（"2：
"＆MySht、ＵsedRaｎgｅ、Ｒows、Count）、Dｅleｔe
EｎdIf
Nexｔ ＭyShｔ
'清除完成
’逐个打开读入原始文件新数据
SｅtＳhtJC ＝ TｈｉsWorkboｏk、Sheets（"基础”）
FｏrＥａｃhＭｙRngIn ＳhｔＪC、Rangｅ（"原始数据文件［原始数据文件］”）
Wｏrkbｏoks、Opｅｎ MyRｎg、Valｕe，3,True，， ，，True '只读方式打开原始数据文件
ShtJC、Ｃｅｌls（MyRng、Row,2）=（MyＲｎg、Vaｌue）＇记录原始文件得最终修改时间
MyＮamｅPath =SｈｔＪC、Ceｌls（MyRng、Ｒow，4） &"\收款、ｘlsx”
Wｏrkbookｓ、ＯpenMｙNamePatｈ,3，Ｆalｓe， ，，,Ｔruｅ '读写方式打开对账工作簿
WithWorkboｏks（"收款、ｘｌsx"）、Sｈeeｔs（"房款”）
、Ｒｏws（＂2:
＂ ＆、UsｅdRaｎｇｅ、Ｒows、Couｎt）、Ｄeｌete
Eｎd Wｉth
ＴｈisWoｒkbooｋ、Acｔｉvaｔe
ForＥach MyShtInWorkshｅetｓ
MyRｏｗs ＝ＭyShｔ、UｓｅｄRａｎgｅ、Rows、Count
If MySht、Ｎaｍe ＜〉”基础"AｎdMｙSｈｔ、Naｍe<＞”日报数据＂Ｔｈeｎ
IfMyShｔ、Cｅlls（MｙRｏws，1）> ＂ ” Then’表格后面无空行时添加一行
ＭySht、Ｒａnｇe（ＭyShｔ、Nａｍe）、LisｔＯbｊect、ListRows、AddAｌwayｓInseｒt:
=Ｔrue
ＭyRows＝ MｙRows+1
EnｄＩf
’读入原始数据
Workｂooks（”销售数据、xlsm"）、Ｓhｅｅｔs（ＭyＳht、Ｎaｍe）、Rangｅ（MySｈt、Naｍe）、Ｃopｙ
MyＳht、Ｃeｌｌs（ＭyRｏws，1）、PasteSpeciａlPａsｔe:
=xlＰasｔｅVaｌues,_
Opｅratｉoｎ：
=xlNｏｎe， SkipＢlanｋs:
＝Fａlｓe, Ｔranspose：
=Faｌｓe
IfMySｈｔ、Ｎａmｅ =＂房款” Theｎ
Wｏrkbooks（＂收款、xlsx"）、Sheets（”房款”）、Ｃｅｌlｓ（2,1）、PａsｔeSｐecｉaｌPaste:
=xlPaｓｔｅＶalues，＿
Operatｉｏｎ:
=xｌNone,SｋiｐBｌankｓ:
=Ｆalsｅ， Traｎｓpose：
=Faｌse
Ｗorｋbookｓ（”收款、ｘｌsx”）、CｌｏｓeSavｅchaｎｇeｓ:
=Ｔrｕe
EnｄＩf
＇读入原始数据完成
EｎdIf
NeｘtMyＳht
＇备份原始数据
MyWordｂookＮame＝ShtJＣ、Ceｌls（MｙRng、Row，5）＆＂销售数据” ＆Formaｔ（Ｄay（Datｅ），”00＂）& ”、ｘlsm"’设置备份文件名称
MｙNamePath=ThisＷｏrkbｏoｋ、Ｐath ＆"＼备份＼" ＆MyＷordbｏoｋName＇设置备份文件路径与名称
KiｌlMyNaｍePath
Wｏrkboｏｋs（"销售数据、xlsｍ"）、SaｖeAｓMyNａmePatｈ
Wｏrkｂoｏks（MyWorｄｂookName）、CｌoseSaｖｅchａngｅs：
=Faｌse’备份完成,关闭备份得文件
NexｔMyRng'下一个原始数据文件
’完成原始数据读入
’形成日报数据
ＷｉｔｈSｈtJC'ThisWｏrkboｏk、Sｈeeｔs（"基础”）
FoｒＥachＭyRngIn、Range（”分期[分期］”）＇遍历分期数据行
MｙRow=MyRng、Row
ForI=０To 3＇范围（本日、本月、本年、项目）
FoｒJ=0 Ｔｏ２’状态（０认购1签约2退房）
Ｓｅt MｙＳht=ThisWｏｒｋbook、Shｅets（”日报数据＂）
IfMｙShｔ、Ceｌlｓ（2，1）〉" ＂Ｔheｎ '如果不就是空表格就增加一个新空行
MySht、Rangｅ（"日报数据”）、ListOｂject、ＬｉｓtRowｓ、AddAlｗaysInｓert:
=Tｒue
ＥnｄIf
MｙRows= MyＳht、UsedRaｎge、Rｏws、Ｃouｎt '记录表格最后一行以方便后面插入数据
’把数据写入日报数据表
MyShｔ、Cｅlls（MyRｏwｓ,1） =、Cells（ＭyRow,１） '写入项目名称
MySｈt、Celｌs（MyRowｓ, ２） =、Cellｓ（MｙRow， 2）'写入分区名称
MySht、Ｃeｌls（MyRoｗｓ， 3）＝、Cｅｌls（MyRｏw， ３）’写入分期名称
MySht、Cells（MyRows，4）＝Ftｗｗ（Ｉ）'写入范围
MySht、Cells（MyRows, 5） =Ｖｌｔd（J） ＇写入状态
ＮextJ’状态
NextI’范围
NｅxtMyＲｎg ＇分期
’完成日报数据
’形成新得空表报文件
Kｉll、Cells（２，1）'删除原报表文件
、Ceｌlｓ（3, 1），、Cｅlｌs（2，1）'从模板复制出新文件
SetＭyWb = Wｏｒｋｂookｓ、Ｏpen（ＴhisWｏｒkｂoｏk、Shｅetｓ（"基础”）、Cellｓ（２， 1））'打开新文件
ＥndWｉｔh'ThisWorkbｏok、Shｅeｔs（"基础＂）
Wｉth MｙWｂ
、Sheeｔs（"销售日报＂）、Celｌｓ（6, 2）=Daｔe-1＇记录报表截至日期
、Ｓheets（＂基础＂）、Rａｎgｅ（”原始数据文件表[最新版本日期]"）、Valuｅ=_
ShtJC、Ｒangｅ（＂原始数据文件［最新版本日期］＂）、Value
ForＥaｃh MyRngInShtJC、Rａnge（”数据工作表"）
IｆMyRnｇ、Value ="基础" Tｈｅn
、Ｓhｅeｔs（”基础＂）、Raｎｇe（”原始数据文件表[最新版本日期]”）、Ｖalｕｅ=_
ＳｈtJC、Rａnge（＂原始数据文件［最新版本日期］"）、Ｖaluｅ
Else
’、Sheets（MyＲng、Vaｌｕｅ）、Raｎｇe（MｙＲng、Ｖaｌue）、Rowｓ、Delｅte
ThiｓＷｏｒkｂooｋ、Shｅetｓ（MｙRｎg、Valｕe）、Ｒangｅ（ＭyRng、Value）、Copy
、Shｅets（ＭyRng、Ｖalｕe）、Ｃelｌｓ（２, １）、PasｔｅSpｅｃial Paｓte:
=xlＰasｔeValues，Operation:
＝xlNｏne,_
ＳkｉｐBlankｓ：
＝Ｆalse， Tｒanｓpose：
=Falｓe
Ｅｎｄ Iｆ
NｅxtMｙRng＇数据行，处理其她工作表
、ReｆreshAll ’刷新表报
、Save ’保存新报表
、shｅeets（”日报＂）、Celｌs（1, 8）、Ｓｅlｅct
Ａpplｉcａｔion、ScrｅｅnＵpdatｉnｇ=Truｅ
Applicａtion、ＤisplaｙAlerts= Trｕe’打开相响应与确认
ＯｎＥｒrｏrGoTo0
If Tｉme< TimeVaｌue（YＸＪUZIUK）Tｈen
、Ｃlosｅ Sａvｅchａngeｓ：
=True’退出报表
ThisWｏｒkboｏk、CloseSaｖｅｃｈａnges:
=True’退出本簿
Ａpplicatｉon、Ｑｕiｔ
End Iｆ
EndWiｔh
EnｄSub
3表报，使用数据透视获得所有需要得数据成果
3.1总指标
２016／１1/1
3.2销售统计总表
1本日
认购
１
97
7９，711
10,０００
6９，711
签约
0
０
4，925，416
464，９８7
4,4６0，429
退房
0
０
0
０
０
2本月
认购
1
97
79，711
10,０00
６9,７11
签约
0
０
5,404，406
４6４，９87
4，939,４19
退房
0
0
0
０
0
3本年
认购
524
６3,2３４
3,494，９63
３,356，856
1３8,10７
签约
556
67,211
4３5，670,4９9
４２８，２91,352
7，3７9，1４7
退房
４
５8６
0
—７98，５91
0
４项目
认购
1，５34
18１，8６１
4,０73，963
３,778,８56
295，10７
签约
1，4９5
177,353
1，004，9２２，220
995，1８１，４７2
9，74０,748
退房
5
715
0
2，173，９77
0
3.3项目销售统计表
项目1
1本日
认购
1
97
7９,711
１0,000
69,711
签约
0
0
2，179,372
464，987
１，７14,385
退房
0
0
0
０
０
2本月
认购
１
9７
79,711
１0，０00
6９，711
签约
０
０
２,658,３62
46４，987
2，193,３75
退房
0
0
0
０
0
3本年
认购
３51
4０，6１0
３,45４，９63
３,316，8５6
１38，107
签约
380
44，325
22７，９７2，468
223,309,３6５
4,66３，103
退房
0
0
0
300,000
0
4项目
认购
950
１09，３25
3,733,96３
３,43８，８56
29５，1０7
签约
924
106，７０1
557,783，７25
550，7８9,02１
6，99４,７0４
退房
0
0
0
1,3４3，137
0
项目2
3.4分区分期销售统计表
项目1
A
０
1本日
认购
0
０
0
0
０
签约
0
0
68４,398
0
684，３98
退房
０
0
0
0
０
２本月
认购
0
0
0
０
0
签约
0
0
6８4,39８
０
６８4，３９８
退房
0
0
0
0
0
3本年
认购
5７
8，8４６
500,000
500,000
0
签约
６3
９，66５
５１,5２1，928
５0，253,５3０
1,２６8，３９8
退房
0
0
０
０
0
4项目
认购
511
61,４13
５６2，000
5６2,0００
0
签约
5１1
61,414
3５２，5７1，６２1
35１，０８３,２23
1，4８8,３98
退房
0
0
０
８11,５47
0
B
1
１本日
认购
1
97
７9，711
1０,000
6９，711
签约
0
0
1,494，9７4
464,９87
1，029，987
退房
０
0
0
0
0
２本月
认购
１
97
７9，711
10，000
69,７１1
签约
0
0
１,97３，９６4
4６4，９87
1，５08,9７７
退房
0
0
0
０
0
3本年
认购
294
3１,７64
２，９54，963
２，816，８56
138，10７
签约
317
3４，660
176，450,5４０
１7３,055，835
３，３９4，７０5
退房
0
0
0
3０0,00０
0
4项目
认购
4３9
４７，911
3，171，963
2,876，856
295,１07
签约
４１
升级会员 