利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx
- 文档编号:3994618
- 上传时间:2022-11-27
- 格式:DOCX
- 页数:17
- 大小:25.92KB
利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx
《利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx》由会员分享,可在线阅读,更多相关《利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表.docx(17页珍藏版)》请在冰豆网上搜索。
利用Excel的VBA代码实现自动化收集原始数据汇总计算和报表
利用Excel得VBA代码实现自动化ﻫ“收集原始数据、汇总计算与报表”
联系人:
杨先生ﻩ电话:
电子邮箱:
以房地产销售数据为例.
两个销售中心以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"'设置自动运行结束最迟时刻
DimMyWb AsWorkbook’打开得工作表(原始数据与报表)
Dim MySht,ShtJCAsWorksheet’打开工作薄得指定工作表与本工作簿得指定工作表
DimMyTb,ThisTbAsListObject'打开工作薄得指定表格与本工作簿得指定表格
DimMyRngAsRange
DimMyNamePath, Vltd(3), Ftww(4) AsString
Dim MyRow,MyRows,MyRngR,MyRngC,I, J,AnsAsLong
OnErrorResume Next'出现错误不提示,直接运行下一行代码
Application、ScreenUpdating =False '关闭屏幕刷新
Application、DisplayAlerts=False'关闭相应与确认
IfTime〉TimeValue(YXJUZIUK)Then'如果不在凌晨打开 ,确认就是否运行代码
Ans=MsgBox("要进行数据运算吗?
",vbYesNo, "请确认就是否进行数据运算")
IfAns =vbNoThenExitSub
EndIf
Vltd(0)= ”认购"
Vltd
(1)="签约"
Vltd
(2) ="退房”
Ftww(0)=”1本日"
Ftww
(1)="2本月"
Ftww(2)= "3本年”
Ftww(3) =”4项目”
MyNamePath= ”"
'清除汇总计算工作簿原有数据
ForEachMyShtInWorksheets
IfMySht、Name〈> "基础"Then'如果不就是基础表,清除原有数据
MySht、Rows("2:
"&MySht、UsedRange、Rows、Count)、Delete
EndIf
Next MySht
'清除完成
’逐个打开读入原始文件新数据
SetShtJC = ThisWorkbook、Sheets("基础”)
ForEachMyRngIn ShtJC、Range("原始数据文件[原始数据文件]”)
Workbooks、Open MyRng、Value,3,True,, ,,True '只读方式打开原始数据文件
ShtJC、Cells(MyRng、Row,2)=(MyRng、Value)'记录原始文件得最终修改时间
MyNamePath =ShtJC、Cells(MyRng、Row,4) &"\收款、xlsx”
Workbooks、OpenMyNamePath,3,False, ,,,True '读写方式打开对账工作簿
WithWorkbooks("收款、xlsx")、Sheets("房款”)
、Rows("2:
" &、UsedRange、Rows、Count)、Delete
End With
ThisWorkbook、Activate
ForEach MyShtInWorksheets
MyRows =MySht、UsedRange、Rows、Count
If MySht、Name <〉”基础"AndMySht、Name<>”日报数据"Then
IfMySht、Cells(MyRows,1)> " ” Then’表格后面无空行时添加一行
MySht、Range(MySht、Name)、ListObject、ListRows、AddAlwaysInsert:
=True
MyRows= MyRows+1
EndIf
’读入原始数据
Workbooks(”销售数据、xlsm")、Sheets(MySht、Name)、Range(MySht、Name)、Copy
MySht、Cells(MyRows,1)、PasteSpecialPaste:
=xlPasteValues,_
Operation:
=xlNone, SkipBlanks:
=False, Transpose:
=False
IfMySht、Name ="房款” Then
Workbooks("收款、xlsx")、Sheets(”房款”)、Cells(2,1)、PasteSpecialPaste:
=xlPasteValues,_
Operation:
=xlNone,SkipBlanks:
=False, Transpose:
=False
Workbooks(”收款、xlsx”)、CloseSavechanges:
=True
EndIf
'读入原始数据完成
EndIf
NextMySht
'备份原始数据
MyWordbookName=ShtJC、Cells(MyRng、Row,5)&"销售数据” &Format(Day(Date),”00")& ”、xlsm"’设置备份文件名称
MyNamePath=ThisWorkbook、Path &"\备份\" &MyWordbookName'设置备份文件路径与名称
KillMyNamePath
Workbooks("销售数据、xlsm")、SaveAsMyNamePath
Workbooks(MyWordbookName)、CloseSavechanges:
=False’备份完成,关闭备份得文件
NextMyRng'下一个原始数据文件
’完成原始数据读入
’形成日报数据
WithShtJC'ThisWorkbook、Sheets("基础”)
ForEachMyRngIn、Range(”分期[分期]”)'遍历分期数据行
MyRow=MyRng、Row
ForI=0To 3'范围(本日、本月、本年、项目)
ForJ=0 To2’状态(0认购1签约2退房)
Set MySht=ThisWorkbook、Sheets(”日报数据")
IfMySht、Cells(2,1)〉" "Then '如果不就是空表格就增加一个新空行
MySht、Range("日报数据”)、ListObject、ListRows、AddAlwaysInsert:
=True
EndIf
MyRows= 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) '写入状态
NextJ’状态
NextI’范围
NextMyRng '分期
’完成日报数据
’形成新得空表报文件
Kill、Cells(2,1)'删除原报表文件
、Cells(3, 1),、Cells(2,1)'从模板复制出新文件
SetMyWb = Workbooks、Open(ThisWorkbook、Sheets("基础”)、Cells(2, 1))'打开新文件
EndWith'ThisWorkbook、Sheets("基础")
With MyWb
、Sheets("销售日报")、Cells(6, 2)=Date-1'记录报表截至日期
、Sheets("基础")、Range(”原始数据文件表[最新版本日期]")、Value=_
ShtJC、Range("原始数据文件[最新版本日期]")、Value
ForEach MyRngInShtJC、Range(”数据工作表")
IfMyRng、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)、Cells(2, 1)、PasteSpecial Paste:
=xlPasteValues,Operation:
=xlNone,_
SkipBlanks:
=False, Transpose:
=False
End If
NextMyRng'数据行,处理其她工作表
、RefreshAll ’刷新表报
、Save ’保存新报表
、sheeets(”日报")、Cells(1, 8)、Select
Application、ScreenUpdating=True
Application、DisplayAlerts= True’打开相响应与确认
OnErrorGoTo0
If Time< TimeValue(YXJUZIUK)Then
、Close Savechanges:
=True’退出报表
ThisWorkbook、CloseSavechanges:
=True’退出本簿
Application、Quit
End If
EndWith
EndSub
3表报,使用数据透视获得所有需要得数据成果
3.1总指标
2016/11/1
3.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,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项目销售统计表
项目1
1本日
认购
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
签约
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
项目2
3.4分区分期销售统计表
项目1
A
0
1本日
认购
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,547
0
B
1
1本日
认购
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
签约
41
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 利用 Excel VBA 代码 实现 自动化 收集 原始数据 汇总 计算 报表