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

利用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人工报送：

定时拷贝报送，优盘、点对点传输（