利用Excel的VBA代碼實現(xiàn)自動化“收集原始數(shù)據(jù)、匯總計算和報表”

1、無利用利用 ExcelExcel 的的 VBAVBA 代碼實現(xiàn)自動化代碼實現(xiàn)自動化“收集原始數(shù)據(jù)、匯總計算和報表收集原始數(shù)據(jù)、匯總計算和報表”聯(lián)系人：楊先生電話電子郵箱：以房地產(chǎn)銷售數(shù)據(jù)為例。兩個銷售中心以 Excel 記錄銷售活動，原始數(shù)據(jù)和直接使用公式形成的表格模板如下。黃色標題名稱為公式項，根據(jù)已知數(shù)據(jù)自動計算。1原始數(shù)據(jù)收集表1.1 產(chǎn)品表：所有房屋產(chǎn)品，主房、輔房（儲藏室、車庫、車位等）的基本信息；標題名稱標題名稱含義房行房行=ROW(主房)-ROW(主房#標題)，動態(tài)的數(shù)據(jù)行號買受人買受人=IFERROR(INDEX(銷售買受人,售行),)，當前買受人項目

2、項目銷售項目名稱分區(qū)分區(qū)分區(qū)名稱分期分期分期名稱樓樓數(shù)字樓號單單數(shù)字單元號層層數(shù)字樓層房房數(shù)字方位編號面積面積預(yù)售面積預(yù)售價預(yù)售價預(yù)售價格產(chǎn)權(quán)產(chǎn)權(quán)產(chǎn)權(quán)面積售次售次=COUNTIFS(銷售主房索引,主房索引)，當前的銷售次數(shù)，退房、換房不刪除數(shù)據(jù)，所以用售次區(qū)別售行售行對應(yīng)的銷售數(shù)據(jù)行。房號房號=VALUE(單&TEXT(層,00)&TEXT(房,00)，如 1 單元 1 層東戶表示為 1-0101（數(shù)字的自定義格式）主房索引主房索引=INDEX(項目分區(qū)代碼,MATCH(項目&分區(qū),項目分區(qū)分區(qū)名稱,0)&分期&TEXT(樓,00)&TEXT(房

3、號,00000)， 用于表間互查數(shù)據(jù)銷售索引銷售索引=IFERROR(主房索引&ABS(售序),) ，用于表間互查數(shù)據(jù)總房款總房款已收已收待收待收1.2 銷售表：每次銷售活動的真實記錄，產(chǎn)品的組合及從產(chǎn)品表查取的基本信息；標題名稱標題名稱含義售行售行=ROW(主房)-ROW(銷售#標題)分區(qū)分區(qū)分區(qū)名稱分期分期分期名稱房號房號手工輸入數(shù)字（自定義格式）售序售序當前的銷售次數(shù)，退房、換房不刪除數(shù)據(jù)，所以用售次區(qū)別無買受人買受人業(yè)務(wù)姓名顧問顧問置業(yè)顧問姓名實售價實售價儲號儲號儲款儲款庫號庫號庫款庫款位號位號位款位款總房款總房款合同中填寫的總金額總款總款=ROUND(SUM(主房款,儲款,庫

4、款,位款),0)，自動計算的總金額差異差異=總房款-總款主房面積主房面積=INDEX(主房面積,房行)認購日期認購日期=IFERROR(INDEX(房款實收日,MATCH(銷售索引&定金,房款款類索引,0),)，實交定金日期主房款主房款=ROUND(實售價*主房面積,0)房約日房約日購房合同簽署日期房約價房約價合同單價買受人身份證號買受人身份證號共有人共有人共有人身份證號共有人身份證號合同交房日合同交房日貸行貸行貸含貸含貸款對象包含儲藏室（C）、車庫（K）等貸額貸額公貸公貸資料日資料日貸款資料合格日貸約日貸約日貸款合同簽署日商放商放=SUMIFS(房款金額,房款銷售索引,銷售索引,房款

5、實收日,40544,房款款類,商貸)，商業(yè)貸款到賬日公放公放=SUMIFS(房款金額,房款銷售索引,銷售索引,房款實收日,40544,房款款類,公貸)，公積金貸款到賬日已收已收=SUMIFS(房款金額,房款銷售索引,銷售索引,房款實收日,40544,房款款類,找差)，不含找差待收待收=IF(售序0,總房款-已收,0)房行房行=MATCH(主房索引,主房主房索引,0)，對應(yīng)產(chǎn)品表的行號主房索引主房索引=INDEX(項目分區(qū)代碼,MATCH(房款!$B$1&分區(qū),項目分區(qū)分區(qū)名稱,0)&分期&TEXT(房號,0000000)銷售索引銷售索引=主房索引&ABS(售序)

6、換房換房因業(yè)務(wù)換房造成本次銷售無效時，記錄換成了哪套房子1.3 房款表：按合約應(yīng)交、實交價款的信息標題名稱標題名稱含義無款款行行=ROW(房款)-ROW(房款#標題)買受人買受人=INDEX(銷售買受人,售行)分區(qū)分區(qū)分期分期房號房號款類款類售序售序收據(jù)號碼收據(jù)號碼應(yīng)收日應(yīng)收日實收日實收日金額金額房類房類打款方式打款方式說明說明房行房行=MATCH(主房索引,主房主房索引,0)售行售行=MATCH(銷售索引,銷售銷售索引,0)售次售次=INDEX(主房售次,房行)主房索引主房索引=$D$1&分期&TEXT(房號,0000000)銷售索引銷售索引=主房索引&售序款類索引款

7、類索引=銷售索引&款類2匯總計算表，使用 VBA 進行原始數(shù)據(jù)合并和統(tǒng)計指標的計算。2.1 日報數(shù)據(jù)指標表（其他數(shù)據(jù)只是原始數(shù)據(jù)合并）標題名稱標題名稱含義項目分區(qū)分期范圍狀態(tài)說明開始日期=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)主房套數(shù)=COU

8、NTIFS(銷售項目,項目,銷售分區(qū),分區(qū),銷售分期,分期,IF(狀態(tài)=認購,銷售認購日,IF(狀態(tài)=簽約,銷售房約日,銷售退房日),&開始日期)主房面積=SUMIFS(銷售主房面積,銷售項目,項目,銷售分區(qū),分區(qū),銷售分期,分期,IF(狀態(tài)=認購,銷售認購日,IF(狀態(tài)=簽約,銷售房約日,銷售退房日),&開始日期)應(yīng)收=IF(狀態(tài)=退房,0,SUMIFS(房款金額,房款款類,找差,房款登錄項目,項目,房款分區(qū),分區(qū),房款分期,分期,房款狀態(tài),狀態(tài),房款應(yīng)收日期,&開始日期,房款應(yīng)收日期,&截至日期)+IF(狀態(tài)=退房,0,SUMIFS(房款金額,房款款類,找差

9、,房款登錄項目,項目,房款分區(qū),分區(qū),房款分期,分期,房款狀態(tài),狀態(tài),房款應(yīng)收日期,&開始日期,房款實收日,)實收=SUMIFS(房款金額,房款款類,找差,房款登錄項目,項目,房款分區(qū),分區(qū),房款分期,分期,房款狀態(tài),狀態(tài),房款實收日,&開始日期,房款實收日, TimeValue(YXJUZIUK) Then 如果不在凌晨打開 , 確認是否運行代碼Ans = MsgBox(要進行數(shù)據(jù)運算嗎?, vbYesNo, 請確認是否進行數(shù)據(jù)運算)If Ans = vbNo Then Exit SubEnd IfVltd(0) = 認購Vltd(1) = 簽約Vltd(2) = 退房Ftw

10、w(0) = 1 本日Ftww(1) = 2 本月Ftww(2) = 3 本年Ftww(3) = 4 項目MyNamePath = 清除匯總計算工作簿原有數(shù)據(jù)For Each MySht In WorksheetsIf MySht.Name 基礎(chǔ) Then 如果不是基礎(chǔ)表,清除原有數(shù)據(jù)MySht.Rows(2: & MySht.UsedRange.Rows.Count).DeleteEnd IfNext MySht清除完成逐個打開讀入原始文件新數(shù)據(jù)Set ShtJC = ThisWorkbook.Sheets(基礎(chǔ))For Each MyRng In ShtJC.Range(原始數(shù)據(jù)文

11、件原始數(shù)據(jù)文件)Workbooks.Open MyRng.Value, 3, True, , , , True 只讀方式打開原始數(shù)據(jù)文件ShtJC.Cells(MyRng.Row, 2) = FileDateTime(MyRng.Value) 記錄原始文件的最終修改時間MyNamePath = ShtJC.Cells(MyRng.Row, 4) & 收款.xlsx無Workbooks.Open MyNamePath, 3, False, , , , True 讀寫方式打開對賬工作簿W(wǎng)ith Workbooks(收款.xlsx).Sheets(房款).Rows(2: & .Use

12、dRange.Rows.Count).DeleteEnd WithThisWorkbook.ActivateFor Each MySht In WorksheetsMyRows = MySht.UsedRange.Rows.CountIf MySht.Name 基礎(chǔ) And MySht.Name 日報數(shù)據(jù) ThenIf MySht.Cells(MyRows, 1) Then 表格后面無空行時添加一行MySht.Range(MySht.Name).ListObject.ListRows.AddAlwaysInsert:=TrueMyRows = MyRows + 1End If讀入原始數(shù)據(jù)Wor

13、kbooks(銷售數(shù)據(jù).xlsm).Sheets(MySht.Name).Range(MySht.Name).CopyMySht.Cells(MyRows, 1).PasteSpecial Paste:=xlPasteValues, _Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseIf MySht.Name = 房款 ThenWorkbooks( 收 款 .xlsx).Sheets( 房 款 ).Cells(2, 1).PasteSpecialPaste:=xlPasteValues, _Operation:=xlNone,Skip

14、Blanks:=False,Transpose:=FalseWorkbooks(收款.xlsx).Close Savechanges:=TrueEnd If讀入原始數(shù)據(jù)完成End IfNext MySht備份原始數(shù)據(jù)MyWordbookName=ShtJC.Cells(MyRng.Row,5)& 銷 售 數(shù) 據(jù) &Format(Day(Date), 00) & .xlsm 設(shè)置備份文件名稱MyNamePath = ThisWorkbook.Path & 備份 & MyWordbookName 設(shè)置備份文件路徑和名稱Kill MyNamePathWorkb

15、ooks(銷售數(shù)據(jù).xlsm).SaveAs MyNamePathWorkbooks(MyWordbookName).Close Savechanges:=False 備份完成，關(guān)閉備份的文件Next MyRng 下一個原始數(shù)據(jù)文件完成原始數(shù)據(jù)讀入形成日報數(shù)據(jù)With ShtJC ThisWorkbook.Sheets(基礎(chǔ))For Each MyRng In .Range(分期分期)遍歷分期數(shù)據(jù)行無MyRow = MyRng.RowFor I = 0 To 3 范圍(本日、本月、本年、項目）For J = 0 To 2 狀態(tài)(0 認購 1 簽約 2 退房）Set MySht = ThisWo

16、rkbook.Sheets(日報數(shù)據(jù))If MySht.Cells(2, 1) Then 如果不是空表格就增加一個新空行MySht.Range(日報數(shù)據(jù)).ListObject.ListRows.AddAlwaysInsert:=TrueEnd IfMyRows = MySht.UsedRange.Rows.Count 記錄表格最后一行以方便后面插入數(shù)據(jù)把數(shù)據(jù)寫入日報數(shù)據(jù)表MySht.Cells(MyRows, 1) = .Cells(MyRow, 1) 寫入項目名稱MySht.Cells(MyRows, 2) = .Cells(MyRow, 2) 寫入分區(qū)名稱MySht.Cells(MyRo

17、ws, 3) = .Cells(MyRow, 3) 寫入分期名稱MySht.Cells(MyRows, 4) = Ftww(I) 寫入范圍MySht.Cells(MyRows, 5) = Vltd(J) 寫入狀態(tài)Next J 狀態(tài)Next I 范圍Next MyRng分期完成日報數(shù)據(jù)形成新的空表報文件Kill .Cells(2, 1) 刪除原報表文件FileCopy .Cells(3, 1), .Cells(2, 1) 從模板復(fù)制出新文件Set MyWb = Workbooks.Open(ThisWorkbook.Sheets(基礎(chǔ)).Cells(2, 1) 打開新文件End With Thi

18、sWorkbook.Sheets(基礎(chǔ))With MyWb.Sheets(銷售日報).Cells(6, 2) = Date - 1 記錄報表截至日期.Sheets(基礎(chǔ)).Range(原始數(shù)據(jù)文件表最新版本日期).Value = _ShtJC.Range(原始數(shù)據(jù)文件最新版本日期).ValueFor Each MyRng In ShtJC.Range(數(shù)據(jù)工作表)If MyRng.Value = 基礎(chǔ) Then.Sheets(基礎(chǔ)).Range(原始數(shù)據(jù)文件表最新版本日期).Value = _ShtJC.Range(原始數(shù)據(jù)文件最新版本日期).ValueElse.Sheets(MyRng.Va

19、lue).Range(MyRng.Value).Rows.DeleteThisWorkbook.Sheets(MyRng.Value).Range(MyRng.Value).Copy.Sheets(MyRng.Value).Cells(2,1).PasteSpecialPaste:=xlPasteValues,Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseEnd IfNext MyRng數(shù)據(jù)行,處理其他工作表無.RefreshAll 刷新表報.Save 保存新報表.sheeets(日報).Cells(1, 8).SelectApp

20、lication.ScreenUpdating = TrueApplication.DisplayAlerts = True 打開相響應(yīng)和確認On Error GoTo 0If Time TimeValue(YXJUZIUK) Then.Close Savechanges:=True 退出報表ThisWorkbook.Close Savechanges:=True 退出本簿Application.QuitEnd IfEnd WithEnd Sub3表報，使用數(shù)據(jù)透視獲得所有需要的數(shù)據(jù)成果3.1 總指標區(qū)期總指標區(qū)期總指標一小區(qū)一小區(qū)二小區(qū)二小區(qū)A A 區(qū)區(qū)B1B1 期期B2B2 期期居住區(qū)居住

21、區(qū)商業(yè)區(qū)商業(yè)區(qū)土地面積土地面積建筑面積建筑面積商品房套數(shù)商品房套數(shù)報表日期報表日期2016/11/13.2 銷售統(tǒng)計總表范圍范圍狀態(tài)狀態(tài)主房套數(shù)主房套數(shù)主房面積主房面積應(yīng)收款應(yīng)收款實收款實收款欠收款欠收款1 1 本日本日認購19779,71110,00069,711簽約004,925,416464,9874,460,429退房000002 2 本月本月認購19779,71110,00069,711簽約005,404,406464,9874,939,419退房000003 3 本年本年認購52463,2343,494,9633,356,856138,107簽約55667,211435,670,4

22、99428,291,3527,379,147退房45860-798,59104 4 項目項目認購1,534181,8614,073,9633,778,856295,107簽約1,495177,3531,004,922,220995,181,4729,740,748退房571502,173,97703.3 項目銷售統(tǒng)計表項目項目范圍范圍狀態(tài)狀態(tài)主房套主房套數(shù)數(shù)主房面積主房面積應(yīng)收款應(yīng)收款實收款實收款欠收款欠收款項項目目1 11 1 本日本日認購19779,71110,00069,711簽約002,179,372464,9871,714,385退房000002 2 本月本月認購19779,7111

23、0,00069,711簽約002,658,362464,9872,193,375無退房000003 3 本年本年認購35140,6103,454,9633,316,856138,107簽約38044,325227,972,468223,309,3654,663,103退房000300,00004 4 項目項目認購950109,3253,733,9633,438,856295,107簽約924106,701557,783,725550,789,0216,994,704退房0001,343,1370項項目目2 23.4 分區(qū)分期銷售統(tǒng)計表項目項目 分區(qū)分區(qū) 分期分期 范圍范圍狀態(tài)狀態(tài)主房套主房套數(shù)數(shù)主房面主房面積積應(yīng)收款應(yīng)收款實收款實收款欠收款欠收款項項目目1 1A A01 1 本本日日認購000