背景说明

当需要根据不用客户分发透视表时，意味着透视表需要重复做N次，之所以是透视表不是完全固定的报表，是透视表有一定的灵活性，可自助拉取报表。

我们显然是不可能将事情重复做N次的，经过测试，以下是较为方便通用且成熟方案，除了速度上有一定缺陷。

另外方案：

  • 利用Power Bi的”行安全性“可以做到类似权限管控，数据源切割的效果，但是第一次做的工作量也较大，并且通用性没上面的好。
  • VBA 创建透视表，该任务本质上是利用不同的数据源制作相同的透视表，利用VBA代码自动生成透视表功能也能实现，但是编写VBA代码时工作量也较大，如果不是长期且高频使用，性价比不高。

构建基础文件

根据实际需求,利用 power pivot ，创建需求度量值，完成透视表，并调整好透视表格式。

1.透视表

  • 利用Excel Power Pivot 连接数据库并创建透视表
  • 设置Power Pivot 免密刷新 Excel数据选项卡中的链接属性 修改为保存密码。或者利用windows身份认证免密刷新避免密码

2.刷新功能宏文件

  • 构建带宏的refresh.xls 文件

创建名为refresh.xls的文件，并在其中插入VBA代码，VBA代码如下：
该代码实现刷新该文件下全部xlsx,xls后缀文件。

  1. Sub refresh()
  2. Dim wb As Excel.Workbook
  3. x = ThisWorkbook.Path & "\"
  4. f = Dir(x & "" & "*xls")
  5. Do While f <> ""
  6. If f <> ThisWorkbook.Name Then
  7. Set wb = Workbooks.Open(x & "" & f)
  8.     ActiveWorkbook.RefreshAll
  9.     wb.Save
  10.     wb.Close
  11.     End If
  12.     f = Dir
  13.     Loop
  14. End Sub

Dir函数参考资料
3.脚本

  • 创建vbs脚本

打开Txt文本文件，将以下代码复制，并另存为refreshs.vbs.

Set objExcel = CreateObject("Excel.Application")
objExcel.Visible = False
objExcel.DisplayAlerts=False
Set wb = objExcel.Workbooks.Open("C:\Users\zhongyf\Desktop\make-power-pivot\data\refreshs.xls")
objExcel.Application.Run "refresh"
wb.save
objExcel.Application.quit
  • R中调用脚本
    pathofvbscript = './refreshs.vbs'
shell(shQuote(normalizePath(pathofvbscript)), "cscript", flag = "//nologo")

    完整R脚本

定义函数,并按照拆分维度依次执行

refresh_power_pivot <- function(dt) {
  # connect database--------
  con <- dbConnect(odbc::odbc(), .connection_string = "driver={ODBC Driver 17 for SQL Server};server=172.16.88.2;database=test;uid=zhongyf;pwd=Zyf123456", timeout = 10)
  DBI::dbWriteTable(conn = con, name = "split_table", value = dt, overwrite = TRUE)
  dbDisconnect(con)

  print(paste0("正在刷新", dt[, .N, by = .(老板)][, (老板)], "数据"))

  # output file name
  output_file_name <- paste0("./result/木九十", "-", dt[, .N, by = .(老板)][, (老板)], "-", "动销存数据.xlsx")

  # 提示进度
  print(paste0("数据上传成功,", "接下来打开模板开始刷新"))

  # 执行vbs脚本
  pathofvbscript <- "./basic/refresh.vbs"
  shell(shQuote(normalizePath(pathofvbscript)), "cscript", flag = "//nologo")

  # 等待时间
  Sys.sleep(2)

  print(paste0("数据刷新成功,", "并保存"))

  # 复制并另存文件
  file.copy(from = "./data/model.xlsx", to = "./result")
  file.rename(from = "./result/model.xlsx", to = output_file_name)
}

# 假定完整数据源为dt ,并按照老板字段拆分
dtlist <- split(dt, dt$老板)
# purrr safely功能
savefun <- purrr::safely(refresh_power_pivot)
# 开始刷新
map(dtlist, savefun)