利用excel的vba代码实现自动化收集原始数据汇总计算和报表.docx
- 文档编号:28862401
- 上传时间:2023-07-20
- 格式:DOCX
- 页数:17
- 大小:20.98KB
利用excel的vba代码实现自动化收集原始数据汇总计算和报表.docx
《利用excel的vba代码实现自动化收集原始数据汇总计算和报表.docx》由会员分享,可在线阅读,更多相关《利用excel的vba代码实现自动化收集原始数据汇总计算和报表.docx(17页珍藏版)》请在冰豆网上搜索。
利用excel的vba代码实现自动化收集原始数据汇总计算和报表
利用Excel的VBA代码实现自动化
“收集原始数据、汇总计算和报表”
联系人:
杨先生:
电子邮箱:
yjjp67163.
以房地产销售数据为例。
两个销售中心以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'打开工作薄的指定表格和本工作簿的指定表格
DimMyRngAsRange
DimMyNamePath,Vltd(3),Ftww(4)AsString
DimMyRow,MyRows,MyRngR,MyRngC,I,J,AnsAsLong
OnErrorResumeNext'出现错误不提示,直接运行下一行代码
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
NextMySht
'清除完成
'逐个打开读入原始文件新数据
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)&"\收款.xlsx"
Workbooks.OpenMyNamePath,3,False,,,,True'读写方式打开对账工作簿
WithWorkbooks("收款.xlsx").Sheets("房款")
.Rows("2:
"&.UsedRange.Rows.Count).Delete
EndWith
ThisWorkbook.Activate
ForEachMyShtInWorksheets
MyRows=MySht.UsedRange.Rows.Count
IfMySht.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=0To3'范围(本日、本月、本年、项目)
ForJ=0To2'状态(0认购1签约2退房)
SetMySht=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)'删除原报表文件
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("原始数据文件[最新版本日期]").Value
ForEachMyRngInShtJC.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).PasteSpecialPaste:
=xlPasteValues,Operation:
=xlNone,_
SkipBlanks:
=False,Transpose:
=False
EndIf
NextMyRng'数据行,处理其他工作表
.RefreshAll'刷新表报
.Save'保存新报表
.sheeets("日报").Cells(1,8).Select
Application.ScreenUpdating=True
Application.DisplayAlerts=True'打开相响应和确认
OnErrorGoTo0
IfTime .CloseSavechanges: =True'退出报表 ThisWorkbook.CloseSavechanges: =True'退出本簿 Application.Quit EndIf EndWith EndSub 3表报,使用数据透视获得所有需要的数据成果 3.1总指标 区期总指标 一小区 二小区 A区 B1期 B2期 居住区 商业区 土地面积 建筑面积 商品房套数 报表日期 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 签约 413 45,287 205,212,104 199,705,798 5,506,306 退房 0 0 0 531,590 0 4网络拓扑 4.1原始数据 4.1.1人工报送: 定时拷贝报送,优盘、点对点传输(
- 配套讲稿:
如PPT文件的首页显示word图标,表示该PPT已包含配套word讲稿。双击word图标可打开word文档。
- 特殊限制:
部分文档作品中含有的国旗、国徽等图片,仅作为作品整体效果示例展示,禁止商用。设计者仅对作品中独创性部分享有著作权。
- 关 键 词:
- 利用 excel vba 代码 实现 自动化 收集 原始数据 汇总 计算 报表