R语言拆分列表df按受试者ID生成带标签多sheet Excel文件

需求说明 #

我有一个存储多个dataframe的列表lst，需要为每个受试者ID生成独立的Excel文件，每个文件的sheet数量与列表中的df数量一一对应，同时需要在列表内各个df的列名上方添加预设的标签说明。

示例数据 #

lst<-list(Demographics = structure(list(SubjectID = c("101-01-101", 
"101-02-102", "101-03-103", "101-04-104", "104-05-201"), BRTHDTC = c("1953-07-07", 
"1963-07-02", "1940-09-11", "1955-12-31", "1950-12-04"), SEX = c("Female", 
"Female", "Male", "Male", "Female")), row.names = c(NA, -5L), class = c("tbl_df", 
"tbl", "data.frame")), DiseaseStatus = structure(list(SubjectID = c("101-01-101", 
"101-02-102", "101-03-103", "101-04-104", "104-05-201"), DSDT = c("2016-03-14", 
"2017-04-04", NA, "2016-05-02", "2018-07-06"), DSDT_P = c(NA, 
NA, "UN-UNK-2015", NA, NA)), row.names = c(NA, -5L), class = c("tbl_df", 
"tbl", "data.frame")), Visits = structure(list(SubjectID = c("101-01-101", 
"101-02-102", "101-03-103", "101-04-104", "104-05-201"), Visit = c("Screening: -28 Days to Day 1", 
"Screening: -28 Days to Day 1", "Screening: -28 Days to Day 1", 
"Screening: -28 Days to Day 1", "Screening: -28 Days to Day 1"
), VISND = c(NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_)), row.names = c(NA, -5L), class = c("tbl_df", 
"tbl", "data.frame")))

Label<-structure(list(Var = c("SubjectID", "BRTHDTC", "SEX", "DSDT", 
"DSDT_P", "Visit", "VISND"), label = c("Subject ID", "Birthday", 
"Gender", "DS Date", "DS Date Prob", "Date of Visit", "ND Visit"
)), row.names = c(NA, -7L), class = c("tbl_df", "tbl", "data.frame"))

IDlist = c("101-01-101", 
"101-02-102", "101-03-103", "101-04-104", "104-05-201")

预期输出效果 #

out
$Demographics
# A tibble: 2 x 3
  SubjectID  BRTHDTC    SEX   
  <chr>      <chr>      <chr> 
1 Subject ID Birthday   Gender
2 101-01-101 1953-07-07 Female


$DiseaseStatus
# A tibble: 2 x 3
  SubjectID  DSDT       DSDT_P      
  <chr>      <chr>      <chr>       
1 Subject ID DS Date    DS Date Prob
2 101-01-101 2016-03-14 <NA>        
       

$Visits
# A tibble: 2 x 3
  SubjectID  Visit                        VISND   
  <chr>      <chr>                        <chr>   
1 Subject ID Date of Visit                ND Visit
2 101-01-101 Screening: -28 Days to Day 1 <NA>    

现有代码 #

Indivadual_xlsx<-function(Subject_id){
lst %>% map(~ {nm1 <- deframe(Label)[names(.x)];  filter(., SubjectID == Subject_id) %>% 
    bind_rows(as.list(setNames(names(nm1), nm1)), setNames(., nm1))  })%>%
     write.xlsx(paste0(Subject_id, ".xlsx"))
}
IDlist %>% map(Indivadual_xlsx) 

修正后代码 #

首先确保已安装并加载必要依赖包：

library(tidyverse)
library(openxlsx)

修正后的函数及调用逻辑：

Indivadual_xlsx <- function(Subject_id){
  output_lst <- lst %>% map(~{
    # 匹配当前数据表所有列对应的标签
    col_labels <- deframe(Label)[names(.x)]
    # 筛选当前受试者的对应数据
    sub_data <- filter(.x, SubjectID == Subject_id)
    # 标签行放在最前，后续拼接实际数据，保留原列名
    bind_rows(as_tibble(as.list(col_labels)), sub_data)
  })
  # 写入Excel，每个数据表对应一个独立sheet
  write.xlsx(output_lst, paste0(Subject_id, ".xlsx"))
}

# 批量生成所有受试者的Excel文件，walk无需返回值更适配 IO 操作
IDlist %>% walk(Indivadual_xlsx)

调整说明 #

• 修正了行绑定顺序：先拼接标签行、再拼接受试者实际数据，和预期行顺序一致
• 移除了错误修改列名的逻辑，保留原数据表列名作为Excel表头，标签作为第一行内容展示，完全匹配预期效果
• 遍历ID列表时改用walk函数，仅执行文件写入操作，避免输出无意义的列表返回值

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