R语言：自动化导出来自不同数据框列表的Excel文档

问题描述 #

基础需求 #

需要从多个数据框列表中提取同名Company分组的子数据框，导出为独立Excel文档，每个文档内的工作表统一命名（如Spreadsheet A、Spreadsheet B等）。

初始示例数据

# df1
df1 <- data.frame(
  Company = c("A", "A", "B", "C", "C"),
  ID = c(1234, 1234, 5678, 2468, 2468),
  Charge = c(100, 150, 100, 200, 200)
)

# df2
df2 <- data.frame(
  Company = c("A", "A", "B", "C"),
  ID = c(1234, 1234, 5678, 2468),
  Location = c("NY", "NY", "CHI", "LA")
)

# df3
df3 <- data.frame(
  Company = c("A", "B", "C"),
  ID = c(1234, 5678, 2468),
  `Combined Summary` = c(250, 100, 400)
)

已执行的拆分代码

List_A <- df1 %>% base::split(., .$Company)
List_B <- df2 %>% base::split(., .$Company)
List_C <- df3 %>% base::split(., .$Company)

补充问题：Company值不统一时的报错处理 #

当多个数据框的Company值不统一时，现有方案会报错，需实现自动化导出，允许部分工作簿的工作表数量不一致。

示例数据

DF <- data.frame(
  Company=c('Alpha', 'Alpha', 'Alpha', 'Beta', 'Beta', 'Gamma', 'Epsilon'),
  Location=c('NY', 'NY', 'CHI', 'LA', 'CHI','LA', 'LA' ),
  ID=c('1234', '1234', '1234', '5678', '5678', '2468', '2468'),
  Charge=c(25,25,51, 60,60, 15, 15)
)

DF2 <- data.frame(
  Company=c('Alpha', 'Alpha', 'Beta', 'Beta', 'Delta', 'Delta', 'Delta'),
  Location=c('NY', 'NY', 'CHI', 'LA', 'CHI','LA', 'LA' ),
  ID=c('1234', '1234', '1234', '5678', '4567', '4567', '4567'),
  Charge=c(25,25,51, 60,60, 15, 15)
)

DF3 <- data.frame(
  Company=c('Alpha', 'Alpha', 'Beta', 'Delta', 'Delta','Delta','Delta'),
  Location=c('NY', 'NY', 'CHI', 'LA', 'CHI','LA', 'LA' ),
  ID=c('1234', '1234', '1234', '5678', '4567', '6789', '6789'),
  Charge=c(25,25,51, 60,60, 15, 15)
)

报错代码

path <- "./" # 替换为你的目标路径
list(DF, DF2, DF3) %>%
  purrr::set_names(paste("SpreadsheetA"), paste("SpreadsheetB"), paste("SpreadsheetC")) %>% 
  purrr::map(~ split(.x, .x$Company)) %>%
  purrr::transpose() %>%
  purrr::iwalk(~writexl::write_xlsx(.x, file.path(path, paste0("results_", .y, ".xlsx"))))

解决方案 #

场景1：所有数据框的Company值完全统一 #

方案1：purrr链式操作

library(tidyverse)
library(writexl)

# 定义目标路径，自动创建不存在的目录
path <- "./output"
dir.create(path, showWarnings = FALSE)

# 整合拆分后的列表，统一工作表名并导出
list(List_A, List_B, List_C) %>%
  set_names(c("Spreadsheet A", "Spreadsheet B", "Spreadsheet C")) %>%
  transpose() %>%
  iwalk(function(df_list, company_name) {
    write_xlsx(df_list, file.path(path, paste0(company_name, ".xlsx")))
  })

方案2：基础for循环

library(writexl)

path <- "./output"
dir.create(path, showWarnings = FALSE)

# 获取所有唯一Company名称（因值统一，取任意列表的名称即可）
company_names <- names(List_A)

# 循环每个Company，收集对应子数据框并导出
for (comp in company_names) {
  excel_data <- list(
    "Spreadsheet A" = List_A[[comp]],
    "Spreadsheet B" = List_B[[comp]],
    "Spreadsheet C" = List_C[[comp]]
  )
  write_xlsx(excel_data, file.path(path, paste0(comp, ".xlsx")))
}

场景2：Company值不统一（存在缺失） #

核心思路：先获取所有数据框中出现过的全部Company名称，再对每个Company从各数据框中提取对应子数据框（不存在则跳过），最后导出有数据的工作簿。

修正后的purrr方案

library(tidyverse)
library(writexl)

path <- "./output"
dir.create(path, showWarnings = FALSE)

# 1. 准备数据列表并统一工作表名
df_list <- list(DF, DF2, DF3) %>%
  set_names(c("Spreadsheet A", "Spreadsheet B", "Spreadsheet C"))

# 2. 获取所有数据框中出现的全部Company名称
all_companies <- df_list %>%
  map(~ .x$Company %>% unique()) %>%
  unlist() %>%
  unique()

# 3. 循环每个Company，收集存在的子数据框并导出
walk(all_companies, function(comp) {
  sheet_data <- map(df_list, function(df) {
    if (comp %in% df$Company) {
      df %>% filter(Company == comp)
    } else {
      NULL # 不存在则返回NULL，write_xlsx会自动忽略
    }
  }) %>% discard(is.null) # 移除空元素
  
  # 仅当有数据时导出
  if (length(sheet_data) > 0) {
    write_xlsx(sheet_data, file.path(path, paste0("results_", comp, ".xlsx")))
  }
})

基础for循环方案

library(writexl)
library(dplyr)

path <- "./output"
dir.create(path, showWarnings = FALSE)

# 获取所有唯一Company名称
all_companies <- unique(c(DF$Company, DF2$Company, DF3$Company))

# 定义工作表名与数据框的映射
sheet_names <- c("Spreadsheet A", "Spreadsheet B", "Spreadsheet C")
df_objects <- list(DF, DF2, DF3)
names(df_objects) <- sheet_names

# 循环每个Company
for (comp in all_companies) {
  excel_sheets <- list()
  # 遍历每个数据框，提取对应Company的子数据框
  for (sheet in sheet_names) {
    df <- df_objects[[sheet]]
    if (comp %in% df$Company) {
      excel_sheets[[sheet]] <- df %>% filter(Company == comp)
    }
  }
  # 有数据则导出
  if (length(excel_sheets) > 0) {
    write_xlsx(excel_sheets, file.path(path, paste0("results_", comp, ".xlsx")))
  }
}

内容的提问来源于stack exchange，提问作者CuRious Coder