Shiny应用开发求助：实现Excel合并、筛选与导出功能

我有两个Excel文件，可通过以下R代码生成：

id <- c(1, 2, 3, 4, 5, 6)
state <- c("CA", "PA", "CA", "RA", "PA", "CA")
value <- c(100, 200, 300, 400, 500, 600)
dat1 <- data.frame(id, state, value)
writexl::write_xlsx(dat1, "dat1.xlsx")


id <- c(11, 22, 33, 44, 55, 66)
state <- c("PA", "CA", "PA", "RA", "CA", "PA")
value <- c(1000, 2000, 3000, 4000, 5000, 6000)
dat2 <- data.frame(id, state, value)
writexl::write_xlsx(dat2, "dat2.xlsx")

需求是：

• 上传这两个Excel文件
• 合并数据
• 根据选择的state和value范围筛选数据
• 将筛选后的数据集导出为Excel格式

现有代码已完成上传和合并，但还没关联筛选控件，下载逻辑也有问题，需要完善。现有代码如下：

library(shiny)
library(DT)
library(tidyverse)
library(readxl)
library(writexl)

ui <- fluidPage(sidebarLayout(
  
  sidebarPanel(
    fileInput("exceldata1", "Data1", multiple = FALSE, accept = ".xlsx"),
    fileInput("exceldata2", "Data2", multiple = FALSE, accept = ".xlsx"),
    selectInput("selector", "State", choices = c("CA", "PA", "RA")),
    sliderInput("slider", "Value range",
                min = 100, max = 10000, value = c(100, 4000)),
    actionButton("dl", "Download")
    
  ),
  
  mainPanel(
    DTOutput("combined")
  )
  
))

server <- function(input,output,session){
  
  dat_1 <- reactive({
    req(input$exceldata1)
    inData1 <- input$exceldata1
    if (is.null(inData1)){return(NULL)}
    data1 <- readxl::read_excel(inData1$datapath)
  })
  
  dat_2 <- reactive({
    req(input$exceldata2)
    inData2 <- input$exceldata2
    if (is.null(inData2)){return(NULL)}
    data2 <- readxl::read_excel(inData2$datapath)
  })
  
  output$combined <- renderDT({
    
    merged <- bind_rows(dat_1(), dat_2())
    
  })
  

    output$dl <- downloadHandler(
    filename = "test.xlsx",
    content = function(file) {
      write.csv(merged(), file, row.names = FALSE)
    }
  )

} 

shinyApp(ui = ui, server = server)

以下是修改后的完整代码，已实现筛选关联和正确的Excel导出：

library(shiny)
library(DT)
library(tidyverse)
library(readxl)
library(writexl)

ui <- fluidPage(sidebarLayout(
  
  sidebarPanel(
    fileInput("exceldata1", "Data1", multiple = FALSE, accept = ".xlsx"),
    fileInput("exceldata2", "Data2", multiple = FALSE, accept = ".xlsx"),
    selectInput("selector", "State", choices = c("CA", "PA", "RA")),
    sliderInput("slider", "Value range",
                min = 100, max = 10000, value = c(100, 4000)),
    actionButton("dl", "Download")
    
  ),
  
  mainPanel(
    DTOutput("combined")
  )
  
))

server <- function(input,output,session){
  
  dat_1 <- reactive({
    req(input$exceldata1)
    readxl::read_excel(input$exceldata1$datapath)
  })
  
  dat_2 <- reactive({
    req(input$exceldata2)
    readxl::read_excel(input$exceldata2$datapath)
  })
  
  # 创建合并并筛选的响应式数据集
  filtered_data <- reactive({
    req(dat_1(), dat_2())
    bind_rows(dat_1(), dat_2()) %>%
      filter(state == input$selector,
             value >= input$slider[1],
             value <= input$slider[2])
  })
  
  output$combined <- renderDT({
    filtered_data()
  })
  
  output$dl <- downloadHandler(
    filename = function() {
      paste0("filtered_data_", Sys.Date(), ".xlsx")
    },
    content = function(file) {
      writexl::write_xlsx(filtered_data(), file)
    }
  )

} 

shinyApp(ui = ui, server = server)

• 新增filtered_data响应式对象：将合并数据和筛选逻辑整合在一起，依赖上传的数据集和筛选控件的输入，确保控件变化时数据自动更新。
• 简化dat_1和dat_2的逻辑：req()已经会在输入为空时阻断执行，无需额外判断is.null()。
• 修正下载逻辑：
  • 使用writexl::write_xlsx()替代write.csv()，确保导出的是真正的Excel格式。
  • 文件名加入日期，避免重复下载时覆盖旧文件。
  • 下载内容直接调用filtered_data()，确保导出的是筛选后的最新数据。

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