如何实现R Shiny上传Excel与现有R处理脚本的对接及结果导出

前置说明 #

原有脚本中存在固定路径读取的allSection.xlsx参考文件，为满足所有处理数据完全取自用户上传的要求，我们在Shiny界面新增了该参考文件的上传入口，也可根据实际需求将该文件放到Shiny App同级目录，修改代码为相对路径读取即可。

步骤1：封装原有处理逻辑为可调用函数 #

# 加载依赖包
library(shiny)
library(readxl)
library(xlsx)  
library(tidyxl)
library(dplyr)
library(stringr)

# 处理函数，入参为用户上传的业务Excel路径、allSection参考文件路径
process_excel <- function(biz_file_path, section_file_path){
  data <- tidyxl::xlsx_cells(biz_file_path)
  formats <- tidyxl::xlsx_formats(biz_file_path)
  
  # 筛选加粗格式的表头行和对应工作表
  sheet_data <- data[
    data$local_format_id %in% which(formats$local$font$bold)
    & !is.na(data$character), c("row", "character", 'sheet')] 
  colnames(sheet_data) <- c("rowNumber", "content", 'sheetRow') 
  
  # 筛选包含指定5个表头的工作表
  grouped_sheets <- sheet_data %>%
    group_by(sheetRow, rowNumber, .add = TRUE) %>%
    mutate(check = str_trim(stringr::str_to_lower(content)) %in% c("qty", "item", "description", "rate", "unit")) %>%
    summarise(check = sum(check)) 
  anchor1 <- grouped_sheets %>% filter(check == 5) %>% select(sheetRow) 
  
  z <- data.frame() 
  # 遍历符合要求的工作表处理
  for(sheet in anchor1$sheetRow){
    bold <- data[
      data$local_format_id %in% which(formats$local$font$bold)
      & !is.na(data$character)
      & data$sheet == sheet, c("row", "character")
    ]
    colnames(bold) <- c("rownumber", "content")  
    
    grouped_rows <- bold %>%
      group_by(rownumber) %>%
      mutate(check = str_trim(stringr::str_to_lower(content)) %in% c("qty", "item", "description", "rate", "unit")) %>%
      summarise(check = sum(check))
    
    anchor <- grouped_rows %>% filter(check >= 4) %>% select(rownumber)
    bold_rows <- grouped_rows %>%
      select(rownumber) %>%
      mutate(a_row = rownumber - as.integer(anchor['rownumber'])) %>%
      select(a_row) %>%
      filter(a_row > 0)
    
    excel <- read.xlsx(biz_file_path, 
                       sheetName = sheet,
                       startRow = as.integer(anchor['rownumber']))[c('Item', 'Description', 'Unit', 'Qty', 'Rate')]
    
    excel[,"Type"] <- NA 
    excel[bold_rows$a_row, "Type"] <- "BOLD"
    
    # 过滤无效行
    a = excel[rowSums(is.na(excel)) != ncol(excel), ]
    a=a[- grep("Carried", a$Qty),] 
    a=a[is.na(as.numeric(a$Unit)),] 
    a=a[- grep("Brought forward from", a$Description),]
    e=a[- grep("Collection for", a$Description),]
    
    # 打标
    e[,"IsItem"] <- FALSE 
    e[,"IsPreamble"] <- FALSE
    e[grep("Preambles",e$Description,ignore.case = TRUE),"IsPreamble"]<- TRUE
    
    for (i in 1:length(e$Item)) {
      if(!is.na(e$Description[i]) && !is.na(e$Item[i]) && !is.na(e$Rate[i])&& 
         !is.na(e$Unit[i])&& !is.na(e$Qty[i])){
        e$IsItem[i] <- TRUE
      }
      e$IsPreamble[i] <- ifelse(e$IsPreamble[i] == TRUE && !is.na(e$Type[i]), TRUE, FALSE)
    }
    
    # 读取章节参考表
    v<-read.xlsx(section_file_path, sheetName = "Sheet1")
    e[,"IsSection"] <- FALSE 
    pattern <- paste0(trimws(v$Item),collapse = '|')
    e[grepl(pattern,e$Description,ignore.case = TRUE),"IsSection"]<- TRUE
    
    e[,"IsTitle"] <- FALSE
    e[,"IsInstruction"] <- FALSE
    
    for (i in 1:length(e$Description)) {
      e$IsSection[i] <- ifelse(e$IsSection[i] == TRUE && !is.na(e$Type[i]), TRUE, FALSE)
      if(!is.na(e$Description[i]) && is.na(e$Unit[i]) && is.na(e$Qty[i]) &&
         is.na(e$Rate[i]) && !is.na(e$Type[i]) && e$IsItem[i] == FALSE && e$IsPreamble[i] == FALSE 
         && e$IsSection[i] == FALSE){
        e$IsTitle[i] <- TRUE
      }
      if(!is.na(e$Description[i]) && is.na(e$Unit[i]) && is.na(e$Qty[i]) &&
         is.na(e$Rate[i]) && is.na(e$Type[i]) && e$IsItem[i] == FALSE && e$IsPreamble[i] == FALSE 
         && e$IsSection[i] == FALSE && e$IsTitle[i] == FALSE){
        e$IsInstruction[i] <- TRUE
      }
    }
    e[, "Sheet_Name"] <- sheet
    z = rbind(z, e)
  }
  df = subset(z, select = -c(Item, IsPreamble))
  return(df)
}

步骤2：完整Shiny交互界面实现 #

# UI部分
ui <- fluidPage(
  titlePanel("Excel批量处理工具"),
  sidebarLayout(
    sidebarPanel(
      # 业务Excel上传
      fileInput("biz_file", "上传待处理的Excel文件",
                accept = c(".xlsx")),
      # 参考章节表上传
      fileInput("section_file", "上传allSection.xlsx参考文件",
                accept = c(".xlsx")),
      # 处理按钮
      actionButton("process_btn", "开始处理", class = "btn-primary"),
      hr(),
      # 自定义列输入区域（处理完成后显示）
      conditionalPanel(
        condition = "output.process_done == true",
        h4("自定义输出列设置"),
        textInput("col1_name", "第一列列名", value = "自定义列1"),
        textInput("col1_value", "第一列填充内容", value = ""),
        textInput("col2_name", "第二列列名", value = "自定义列2"),
        textInput("col2_value", "第二列填充内容", value = ""),
        # 下载按钮
        downloadButton("download_btn", "下载处理结果", class = "btn-success")
      )
    ),
    mainPanel(
      h3("处理结果预览"),
      tableOutput("result_preview")
    )
  )
)

# Server部分
server <- function(input, output, session) {
  # 存储处理后的原始数据
  processed_df <- reactiveVal(NULL)
  # 标记处理是否完成
  output$process_done <- reactive({
    !is.null(processed_df())
  })
  outputOptions(output, "process_done", suspendWhenHidden = FALSE)
  
  # 监听处理按钮点击
  observeEvent(input$process_btn, {
    req(input$biz_file, input$section_file)
    # 调用处理函数
    df <- process_excel(input$biz_file$datapath, input$section_file$datapath)
    processed_df(df)
    # 显示预览
    output$result_preview <- renderTable({
      head(processed_df(), 20)
    })
  })
  
  # 拼接用户自定义列生成最终数据
  final_df <- reactive({
    req(processed_df())
    df <- processed_df()
    # 加入用户输入的两列
    if(nchar(input$col1_name) > 0){
      df[[input$col1_name]] <- input$col1_value
    }
    if(nchar(input$col2_name) > 0){
      df[[input$col2_name]] <- input$col2_value
    }
    return(df)
  })
  
  # 下载功能
  output$download_btn <- downloadHandler(
    filename = function(){
      paste0("处理结果_", Sys.Date(), ".xlsx")
    },
    content = function(file){
      write.xlsx(final_df(), file, row.names = FALSE)
    }
  )
}

# 运行App
shinyApp(ui, server)

使用说明 #

1. 依次上传待处理的业务Excel和allSection.xlsx参考文件
2. 点击「开始处理」，等待处理完成后会预览前20行结果
3. 按需输入两个自定义列的列名和填充内容
4. 点击「下载处理结果」即可导出完整的处理后文件

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