CODEWITHSUNDEEP
rexceltidyverse
mzuba
mzuba

Reputation: 1275

create multi-headed table and paste to excel

Often I find that a large proportion of my work consists of summarising data in excel sheets.

I use R to do my calculations and then paste the data to Excel because that's what my organisation uses.

I have not found a good way to do this with multi-headed data.

for example, a typical workflow would look like this:

my_data <- crossing(
  year = 2010:2020, 
  region = LETTERS[1:10], 
  type = paste("Type ", c("I", "II", "III"))) %>% 
  mutate(value = runif(n = n()))

my_calculation <- my_data %>% 
  mutate(
    .by = c(year, type), 
    share = value/sum(value))

my_table <- my_calculation %>% 
  pivot_wider(names_from = region, values_from = c(value, share))

write.table(my_table, "clipboard", sep = "\t", row.names = FALSE)

this, I would copy to Excel and then manually reformat:

enter image description here

What I am looking for is a package that will help me with handling the multi-headed tables.

I know that there are various packages that can produce multi-headed tables, but they produce HTML output; nothing that can be easily pasted into Excel.

For example, the code below would produce such a multi-headed table, but I don't know a simple way to paste this into an Excel sheet.

ft <- my_table %>% flextable::flextable() %>% 
  ftExtra::span_header()

If I mark everything and paste to Excel, every cell value, all content will be in the first row.

Upvotes: 0

Views: 46

Answers (1)

Tim G
Tim G

Reputation: 4147

You could use the flextable object ft as preparation and then use openxlsx to print the table directly to Excel. openxlsx allows you to style your table and directly write data in an excel sheet. This code identifies repeated column values and merges cells accordingly.

out1

if(!require("pacman")) install.packages("pacman")
library("pacman")
p_load(tidyverse, ftExtra, openxlsx, flextable)

my_data <- crossing(
  year = 2010:2020, 
  region = LETTERS[1:10], 
  type = paste("Type ", c("I", "II", "III"))) %>% 
  mutate(value = runif(n = n()))

my_calculation <- my_data %>% 
  mutate(
    .by = c(year, type), 
    share = value/sum(value))

my_table <- my_calculation %>% 
  pivot_wider(names_from = region, values_from = c(value, share))

# determine multiheaded table
ft <- my_table %>% flextable() %>% span_header()

# crate workbook and sheet
wb <- createWorkbook()
addWorksheet(wb, 1)

header_data <- ft$header$dataset # Extract header structure from ft
writeData(wb, 1, header_data, startRow = 1, colNames = FALSE)

# Detect and merge cells automatically
for (row_idx in 1:nrow(header_data)) {
  row <- unlist(header_data[row_idx, ])  # Extract row values
  groups <- rle(row)  # Identify repeated values
  col_positions <- cumsum(c(1, head(groups$lengths, -1)))  # Column positions
  
  for (i in seq_along(groups$values)) { # Merge only column cells where labels are repeated
    if (groups$lengths[i] > 1) {
      mergeCells(wb, 1, cols = col_positions[i]:(col_positions[i] + groups$lengths[i] - 1), rows = row_idx)
    }
  }
}

# Apply styles
headerStyle <- createStyle(textDecoration = "bold", halign = "center")
addStyle(wb, 1, headerStyle, rows = 1:2, cols = 1:ncol(my_table), gridExpand = TRUE)

# Write main table data below headers
writeData(wb, 1, my_table, startRow = nrow(header_data) + 1, colNames = FALSE)

# Save workbook
saveWorkbook(wb, "Multiheaded_Table.xlsx", overwrite = TRUE)

Upvotes: 0

Related Questions