利用Excel的VBA代码实现自动化“收集原始数据、汇总计算和报表”联系人：杨先生：电子邮箱：yjjp67163.以房地产销售数据为例。

两个销售中心以Excel记录销售活动，原始数据和直接使用公式形成的表格模板如下。

黄色标题名称为公式项，根据已知数据自动计算。

1原始数据收集表2.2VBA代码Private Sub Workbook_Open()Const YXJUZIUK As String = "05:00:00" '设置自动运行结束最迟时刻Dim MyWb As Workbook '打开的工作表（原始数据和报表）Dim MySht, ShtJC As Worksheet '打开工作薄的指定工作表和本工作簿的指定工作表Dim MyTb, ThisTb As ListObject '打开工作薄的指定表格和本工作簿的指定表格Dim MyRng As RangeDim MyNamePath, Vltd(3), Ftww(4) As StringDim MyRow, MyRows, MyRngR, MyRngC, I, J, Ans As LongOn Error Resume Next '出现错误不提示,直接运行下一行代码Application.ScreenUpdating = False '关闭屏幕刷新Application.DisplayAlerts = False '关闭相应和确认If Time > TimeValue(YXJUZIUK) Then '如果不在凌晨打开, 确认是否运行代码Ans = MsgBox("要进行数据运算吗?", vbYesNo, "请确认是否进行数据运算")If Ans = vbNo Then Exit SubEnd IfVltd(0) = "认购"Vltd(1) = "签约"Vltd(2) = "退房"Ftww(0) = "1本日"Ftww(1) = "2本月"Ftww(2) = "3本年"Ftww(3) = "4项目"MyNamePath = ""'清除汇总计算工作簿原有数据For Each MySht In WorksheetsIf <> "基础" Then '如果不是基础表,清除原有数据MySht.Rows("2:" & edRange.Rows.Count).DeleteEnd IfNext MySht'清除完成'逐个打开读入原始文件新数据Set ShtJC = ThisWorkbook.Sheets("基础")For Each MyRng In ShtJC.Range("原始数据文件[原始数据文件]")Workbooks.Open MyRng.Value, 3, True, , , , True '只读方式打开原始数据文件ShtJC.Cells(MyRng.Row, 2) = FileDateTime(MyRng.Value) '记录原始文件的最终修改时间MyNamePath = ShtJC.Cells(MyRng.Row, 4) & "\收款.xlsx"Workbooks.Open MyNamePath, 3, False, , , , True '读写方式打开对账工作簿With Workbooks("收款.xlsx").Sheets("房款").Rows("2:" & .UsedRange.Rows.Count).DeleteEnd WithThisWorkbook.ActivateFor Each MySht In WorksheetsMyRows = edRange.Rows.CountIf <> "基础" And <> "日报数据" ThenIf MySht.Cells(MyRows, 1) > " " Then '表格后面无空行时添加一行MySht.Range().ListObject.ListRows.Add AlwaysInsert:=TrueMyRows = MyRows + 1End If'读入原始数据Workbooks("销售数据.xlsm").Sheets().Range().CopyMySht.Cells(MyRows, 1).PasteSpecial Paste:=xlPasteValues, _Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseIf = "房款" ThenWorkbooks("收款.xlsx").Sheets("房款").Cells(2, 1).PasteSpecial Paste:=xlPasteValues, _Operation:=xlNone, SkipBlanks:=False, Transpose:=FalseWorkbooks("收款.xlsx").Close Savechanges:=TrueEnd If'读入原始数据完成End IfNext MySht'备份原始数据MyWordbookName = ShtJC.Cells(MyRng.Row, 5) & "销售数据" & Format(Day(Date), "00") & ".xlsm" '设置备份文件名称MyNamePath = ThisWorkbook.Path & "\备份\" & MyWordbookName '设置备份文件路径和名称Kill MyNamePathWorkbooks("销售数据.xlsm").SaveAs MyNamePathWorkbooks(MyWordbookName).Close Savechanges:=False '备份完成，关闭备份的文件Next MyRng ' 下一个原始数据文件'完成原始数据读入'形成日报数据With ShtJC 'ThisWorkbook.Sheets("基础")For Each MyRng In .Range("分期[分期]") '遍历分期数据行MyRow = MyRng.RowFor I = 0 To 3 '范围(本日、本月、本年、项目）For J = 0 To 2 '状态(0认购1签约2退房）Set MySht = ThisWorkbook.Sheets("日报数据")If MySht.Cells(2, 1) > " " Then '如果不是空表格就增加一个新空行MySht.Range("日报数据").ListObject.ListRows.Add AlwaysInsert:=TrueEnd IfMyRows = edRange.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) '写入状态Next J '状态Next I '范围Next MyRng '分期'完成日报数据'形成新的空表报文件Kill .Cells(2, 1) '删除原报表文件FileCopy .Cells(3, 1), .Cells(2, 1) '从模板复制出新文件Set MyWb = Workbooks.Open(ThisWorkbook.Sheets("基础").Cells(2, 1)) '打开新文件End With 'ThisWorkbook.Sheets("基础")With MyWb.Sheets("销售日报").Cells(6, 2) = Date - 1 '记录报表截至日期.Sheets("基础").Range("原始数据文件表[最新版本日期]").Value = _ShtJC.Range("原始数据文件[最新版本日期]").ValueFor Each MyRng In ShtJC.Range("数据工作表")If MyRng.Value = "基础" Then.Sheets("基础").Range("原始数据文件表[最新版本日期]").Value = _ShtJC.Range("原始数据文件[最新版本日期]").ValueElse'.Sheets(MyRng.Value).Range(MyRng.Value).Rows.DeleteThisWorkbook.Sheets(MyRng.Value).Range(MyRng.Value).Copy.Sheets(MyRng.Value).Cells(2, 1).PasteSpecial Paste:=xlPasteValues, Operation:=xlNone, _SkipBlanks:=False, Transpose:=FalseEnd IfNext MyRng '数据行,处理其他工作表.RefreshAll '刷新表报.Save '保存新报表.sheeets("日报").Cells(1, 8).SelectApplication.ScreenUpdating = TrueApplication.DisplayAlerts = True '打开相响应和确认On Error GoTo 0If Time < TimeValue(YXJUZIUK) Then.Close Savechanges:=True '退出报表ThisWorkbook.Close Savechanges:=True '退出本簿Application.QuitEnd IfEnd WithEnd Sub3表报，使用数据透视获得所有需要的数据成果4.1原始数据4.1.1人工报送：定时拷贝报送，优盘、点对点传输（QQ、微信、）4.1.2自动报送：依靠网络自动更新，局域网共享、服务器共享、VBA自动邮件等4.2汇总计算4.2.1人工汇总并报送：接收原始文件到指定文件夹，定时计算并定时拷贝报送，优盘、点对点传输（QQ、微信、）4.2.2自动报送：依靠网络自动更新并自动计算，局域网共享、服务器共享、VBA自动邮件等。