xlsx R package overwriting previous formatting

问题

I am creating an Excel sheet with somewhat complex formatting with the xlsx package.

The problem is when I have already formatted one cell and want to add something on top of that---then the formatting goes back to default except the new thing I am adding.

One solution would be to specify each different case and apply the complete formatting to it. The number of specific cases might grow out of control with a big sheet.

I would guess there must be a away to add formatting step by step but haven't found anything about it in the documentation yet.

A reproducible example of my current way of doing things:

require(xlsx)

# Some random data
n <- 20L
set.seed(1L)
df <- data.frame(species = sample(c("Cat", "Dog", "Unkown"), n, replace = TRUE),
                 speed   = abs(rnorm(n)) * 20L)

# Create workbook
dfwb <- createWorkbook(type = "xlsx")
sheet <- createSheet(dfwb, sheetName = "ani")
addDataFrame(df, sheet, startRow = 1, startColumn = 1, row.names = FALSE)


# Change text of Cat to "red"
row <- getRows(sheet, rowIndex = which(df[, "species"] == "Cat")  + 1L)
cel <- getCells(row, colIndex = 1)
redh_style <- CellStyle(dfwb) + Font(dfwb, color = "red")

for (i in names(cel)) {
  setCellStyle(cel[[i]], redh_style)
}

# Highlight all rows where speed exceeds 18
row <- getRows(sheet, rowIndex = which(df[, "speed"] > 18)  + 1L)
cel <- getCells(row, colIndex = 1:2)
high_style <- CellStyle(dfwb) + Fill(foregroundColor="#E2E6EB")

for (i in names(cel)) {
  setCellStyle(cel[[i]], high_style)
}

# Save 
setwd("c:/temp/csvm/")
saveWorkbook(dfwb, "so_cat.xlsx")

In the end, some of the previously red font is back to black.

Ps. I have tried other packages but would like to stick with xlsx. XLConnect does not allow some kinds of formatting directly from R and has technical difficulties making openxlsx run.

回答1:

Here's one approach. The main idea is to build a parallel list of formats for each cell, where each list element is a cell. This allows you to append formatting attributes as desired. At the very end, we apply this list of formats to each cell.

First, we set up a blank list:

# Set up blank list of formats
fmts <- list()

Now, we format according to the first criteria, adding the font attribute to the fmts list for selected cells:

# Change text of Cat to "red"
row <- getRows(sheet, rowIndex = which(df[, "species"] == "Cat")  + 1L)
cel <- getCells(row, colIndex = 1)

for (i in names(cel)) {
  if (i %in% names(fmts)) {
    fmts[[i]] <- c(fmts[[i]], list(Font(dfwb, color = "red")))
  } else {
    fmts[[i]] <- list(CellStyle(dfwb), Font(dfwb, color = "red"))
  }
}

Next, do the background:

# Highlight all rows where speed exceeds 18
row <- getRows(sheet, rowIndex = which(df[, "speed"] > 18)  + 1L)
cel <- getCells(row, colIndex = 1:2)

for (i in names(cel)) {
  if (i %in% names(fmts)) {
    fmts[[i]] <- c(fmts[[i]], list(Fill(foregroundColor="#E2E6EB")))
  } else {
    fmts[[i]] <- list(CellStyle(dfwb), Fill(foregroundColor="#E2E6EB"))
  }
}

When we inspect fmts, we note that some elements only have two items (the base cell style, plus the font or the background) while others have three (the base cell style, the font, and the background):

str(fmts, m = 1)
# List of 16
#  $ 2.1 :List of 3
#  $ 6.1 :List of 3
#  $ 11.1:List of 2
#  $ 12.1:List of 3
#  $ 13.1:List of 2
#  $ 2.2 :List of 2
#  $ 5.1 :List of 2
#  $ 5.2 :List of 2
#  $ 6.2 :List of 2
#  $ 9.1 :List of 2
#  $ 9.2 :List of 2
#  $ 12.2:List of 2
#  $ 15.1:List of 2
#  $ 15.2:List of 2
#  $ 19.1:List of 2
#  $ 19.2:List of 2

Finally, we iterate through fmts and apply the styles. The Reduce function comes in useful:

# Apply formatting
for (i in names(fmts)) {
  idx <- as.numeric(unlist(strsplit(i, "\\.")))
  cel <- getCells(getRows(sheet, rowIndex = idx[1]), colIndex = idx[2])
  setCellStyle(cel[[i]], 
    Reduce(`+.CellStyle`, fmts[[i]])
  )
}

Output:

来源：https://stackoverflow.com/questions/42699557/xlsx-r-package-overwriting-previous-formatting

标签

excel

XLSX