实现Shiny中两个DT数据表同步横向滚动，保持列对齐

我有一个包含40列的大型数据集，开发了基于dashboardPage的Shiny应用（带筛选侧边栏及另外两个页面），使用DT包构建了两个数据表，分别展示单条数据和整体数据集，需求是横向滚动其中一个表格时，另一个同步滚动并保持列对齐。当前代码仅支持单个表格滚动，且需缩小窗口才会显示滚动条，代码如下：

library(shiny)
library(DT)
library(shinydashboard)
library(shinydashboardPlus)

ui <- dashboardPage(
  dashboardHeader(title = "Credit Analysis"),
  
  dashboardSidebar(),
  dashboardBody(
    DTOutput("table1"),
  DTOutput("table2"),
  tags$script(HTML("
    $(document).ready(function() {
      var table1 = $('#table1').DataTable();
      var table2 = $('#table2').DataTable();
      
      $('#table1').on('scroll', function() {
        $('#table2').scrollLeft($(this).scrollLeft());
      });
      
      $('#table2').on('scroll', function() {
        $('#table1').scrollLeft($(this).scrollLeft());
      });
    });
  "))
  )
)


server <- function(input, output, session) {
  names <- c("Alice", "Bob", "Charlie", "David", "Will", "Sarah", "Kelly")
  names1 <- "Joe"
  ages <- c(25, 30, 35, 40, 23, 44, 33)
  ages1 <- 37
  states <- c("NY", "CA", "IL", "TX", "NY", "TN", "MO")
  states1 <- "IL"
  cities <- c("New York", "Los Angeles", "Chicago", "Houston", "New York", "Nashville", "St Louis")
  cities1 <- "Chicago"
  homevalues <- c(700000, 1100000, 500000, 550000, 850000, 400000, 350000)
  homevalues1 <- 800000
  dependents <- c(0, 1, 1, 3, 0, 0, 1)
  dependents1 <- 2
  employed <- c("Yes", "Yes", "Yes", "No", "No", "Yes", "Yes")
  employed1 <- "Yes"
  incomes <- c(100000, 80000, 65000, 10000, 90000, 150000, 75000)
  incomes1 <- 60000
  creditScore <- c(550, 470, 670, 720, 540, 600, 780)
  creditScore1 <- 690
  
  data <- data.frame(Name = names, Age = ages, State = states, City = cities, Dependents = dependents, Job = employed, CS = creditScore, Income = incomes, Home = homevalues)
  singleData <- data.frame(Name = names1, Age = ages1, State = states1, City = cities1, Dependents = dependents1, Job = employed1, CS = creditScore1, Income = incomes1, Home = homevalues1)  
  
  output$table1 <- renderDT({
    datatable(singleData, options = list(dom = 't', scrollX = TRUE))
  })
  
  output$table2 <- renderDT({
    datatable(data, options = list(scrollX = TRUE))
  })
}

shinyApp(ui, server)

解决方案 #

修改后的代码解决了滚动同步和滚动条显示问题，关键改动如下：

1. 监听正确的滚动容器：DT表格的横向滚动条属于内部的.dataTables_scrollBody元素，而非表格容器本身，需监听该元素的滚动事件。
2. 保证表格宽度一致：给两个表格设置相同的width = "100%"，确保列对齐；scrollX = TRUE强制显示横向滚动条，无需缩小窗口。
3. 延迟脚本执行时机：使用shiny:value事件确保表格渲染完成后再绑定滚动事件，避免DOM元素未加载导致的失效。

修改后的完整代码：

library(shiny)
library(DT)
library(shinydashboard)
library(shinydashboardPlus)

ui <- dashboardPage(
  dashboardHeader(title = "Credit Analysis"),
  
  dashboardSidebar(),
  dashboardBody(
    DTOutput("table1"),
    DTOutput("table2"),
    tags$script(HTML("
      $(document).on('shiny:value', function(event) {
        // 确保两个表格都渲染完成
        if ($('#table1 .dataTables_scrollBody').length && $('#table2 .dataTables_scrollBody').length) {
          const scrollBody1 = $('#table1 .dataTables_scrollBody');
          const scrollBody2 = $('#table2 .dataTables_scrollBody');
          
          // 同步table1到table2的滚动
          scrollBody1.on('scroll', function() {
            scrollBody2.scrollLeft($(this).scrollLeft());
          });
          
          // 同步table2到table1的滚动
          scrollBody2.on('scroll', function() {
            scrollBody1.scrollLeft($(this).scrollLeft());
          });
        }
      });
    "))
  )
)


server <- function(input, output, session) {
  names <- c("Alice", "Bob", "Charlie", "David", "Will", "Sarah", "Kelly")
  names1 <- "Joe"
  ages <- c(25, 30, 35, 40, 23, 44, 33)
  ages1 <- 37
  states <- c("NY", "CA", "IL", "TX", "NY", "TN", "MO")
  states1 <- "IL"
  cities <- c("New York", "Los Angeles", "Chicago", "Houston", "New York", "Nashville", "St Louis")
  cities1 <- "Chicago"
  homevalues <- c(700000, 1100000, 500000, 550000, 850000, 400000, 350000)
  homevalues1 <- 800000
  dependents <- c(0, 1, 1, 3, 0, 0, 1)
  dependents1 <- 2
  employed <- c("Yes", "Yes", "Yes", "No", "No", "Yes", "Yes")
  employed1 <- "Yes"
  incomes <- c(100000, 80000, 65000, 10000, 90000, 150000, 75000)
  incomes1 <- 60000
  creditScore <- c(550, 470, 670, 720, 540, 600, 780)
  creditScore1 <- 690
  
  data <- data.frame(Name = names, Age = ages, State = states, City = cities, Dependents = dependents, Job = employed, CS = creditScore, Income = incomes, Home = homevalues)
  singleData <- data.frame(Name = names1, Age = ages1, State = states1, City = cities1, Dependents = dependents1, Job = employed1, CS = creditScore1, Income = incomes1, Home = homevalues1)  
  
  output$table1 <- renderDT({
    datatable(singleData, options = list(
      dom = 't', 
      scrollX = TRUE,
      width = "100%"  # 保证宽度一致
    ))
  })
  
  output$table2 <- renderDT({
    datatable(data, options = list(
      scrollX = TRUE,
      width = "100%"  # 保证宽度一致
    ))
  })
}

shinyApp(ui, server)

效果说明 #

• 滚动任意一个表格的横向滚动条，另一个表格会同步滚动，列始终对齐
• 页面加载后自动显示横向滚动条，无需手动缩小窗口
• 脚本会在两个表格都渲染完成后才绑定事件，避免初始状态下的失效问题

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