EXPSS多响应表汇总保留标签：无需重复赋值的解决方案问询

I get it—having to re-apply labels hundreds of times is a huge pain. The issue here is that when you extract columns into data1 and build your table, the existing variable labels aren't being picked up properly by the tab_cells call. Here's how to fix it without retyping all those labels:

Key Fix: Extract and Use Existing Variable Labels #

We can leverage expss's var_lab() function to pull the already-assigned labels directly from your original data, then map them to the row labels in your final table.

Here's the revised version of your tab_multi_cross function with the fix included:

tab_multi_cross <- function(data, var_list, first_col_param, second_col_param, grouping_var, total_var){ 
  total_col <- ifelse(total_var== TRUE,1,0) 
  grouping_var <- rlang::parse_expr(grouping_var) 
  
  # Extract existing variable labels from the original data
  var_labels <- sapply(data[var_list], var_lab)
  
  data1 <- data[var_list] %>% as.data.frame() 
  data2 <- data %>% select(all_of(grouping_var)) 
  var_lab(data2[[grouping_var]]) <-"" 
  subset_data <- cbind(data2,data1) 
  
  tab1 <- eval(rlang::parse_expr(paste0("tab_cells(subset_data,mdset(", first_col_param ," %to% ",second_col_param,"))"))) %>% 
    tab_cols(total(), subset_data[1]) %>% 
    tab_stat_cpct() %>% 
    tab_pivot() 
  
  tab1 <- as.data.frame(tab1) 
  tab1[which(tab1[,1]=="#Total cases"),1] <- "N" 
  setnames(tab1,"row_labels"," ") 
  
  # Replace column names (col1, col2...) with their existing labels
  # Only replace rows that match var_list entries (skip the "N" row)
  label_map <- setNames(var_labels, names(var_labels))
  tab1[tab1[[1]] %in% names(label_map), 1] <- label_map[tab1[tab1[[1]] %in% names(label_map), 1]]
  
  tab1[is.na(tab1)] <- 0 
  tab1 <- tab1 %>% mutate( 
    across( 
      .cols = where(is.numeric), 
      .fns = ~ round(.x, digits = 1) 
    ) 
  ) 
  tab1[tab1 == 0] <- '--' 
  mask_indices <- sapply(tab1, function(x) x[length(x)] %in% c(3, 4, 5)) %>% which() 
  tab1[, mask_indices] <- "--" 
  tab1[-nrow(tab1), -c(1, mask_indices)] <- sapply( 
    tab1[-nrow(tab1),-c(1, mask_indices)], function(x) 
      ifelse(x != '--', paste(format(as.numeric(x), nsmall = 1), "%"), x)) 
  i <- match("N", tab1[,1]) 
  tab2 <- rbind(tab1[i,], tab1[-i,]) 
  if(total_col==0){tab2 = tab2[,!grepl("^#Tot",names(tab2))]} 
  tab2 
}

How It Works: #

1. Extract Labels: The line var_labels <- sapply(data[var_list], var_lab) grabs all the existing labels from your original data's var_list columns in one go.
2. Map Labels to Rows: We create a named vector label_map that pairs column names (like col1) with their labels (like Sales), then replace the matching row entries in the table's first column.
3. Skip Non-Variable Rows: We only replace rows that are in var_list, so the "N" row stays intact.

Test It Out: #

Call your function as before, and now you'll see the labels (Sales, OPS, etc.) instead of col1/col2 in the table:

# Example call
result <- tab_multi_cross(data = data, var_list = var_list, first_col_param = "col1", 
                          second_col_param = "col5", grouping_var = "sector", total_var = TRUE)
flextable(result)

This way, you don't have to re-apply labels for every table—you're just reusing the ones you already set up in your original data frame.

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