-
-
Save schaunwheeler/5825002 to your computer and use it in GitHub Desktop.
| xlsxToR <- function(file) { | |
| require(XML) | |
| require(plyr) | |
| suppressWarnings(file.remove(tempdir())) | |
| file.copy(file, tempdir()) | |
| new_file <- list.files(tempdir(), full.name = TRUE, pattern = basename(file)) | |
| new_file_rename <- gsub("xlsx$", "zip", new_file) | |
| file.rename(new_file, new_file_rename) | |
| unzip(new_file_rename, exdir = tempdir()) | |
| # Get names of sheets | |
| sheet_names <- xmlToList(list.files( | |
| paste0(tempdir(), "/xl"), full.name = TRUE, pattern = "workbook.xml")) | |
| sheet_names <- do.call("rbind", sheet_names$sheets) | |
| rownames(sheet_names) <- NULL | |
| sheet_names <- as.data.frame(sheet_names,stringsAsFactors = FALSE) | |
| # Get column classes | |
| styles <- xmlToList(list.files( | |
| paste0(tempdir(), "/xl"), full.name = TRUE, pattern = "styles.xml")) | |
| styles <- styles$cellXfs[ | |
| sapply(styles$cellXfs, function(x) any(names(x) == "applyNumberFormat"))] | |
| styles <- do.call("rbind", lapply(styles, | |
| function(x) as.data.frame(as.list(x[c("applyNumberFormat", "numFmtId")]), | |
| stringsAsFactors = FALSE))) | |
| worksheet_paths <- list.files(paste0(tempdir(), "/xl/worksheets"), | |
| full.name = TRUE, pattern = "xml$") | |
| worksheets <- lapply(worksheet_paths, function(x) xmlToList(x)$sheetData) | |
| worksheets <- lapply(seq_along(worksheets), function(i) { | |
| x <- lapply(worksheets[[i]], function(y) { | |
| y <- y[names(y) == "c"] | |
| y <- lapply(y, function(z) { | |
| z <- unlist(z) | |
| names(z) <- gsub("\\.?attrs\\.?", "", names(z)) | |
| as.data.frame(as.list(z), stringsAsFactors = FALSE) | |
| }) | |
| do.call("rbind.fill", y) | |
| }) | |
| x <- do.call("rbind.fill", x) | |
| x$sheet <- sheet_names[sheet_names$sheetId == i, "name"] | |
| x | |
| }) | |
| worksheets <- do.call("rbind.fill", | |
| worksheets[sapply(worksheets, class) == "data.frame"]) | |
| entries <- xmlToList(list.files(paste0(tempdir(), "/xl"), | |
| full.name = TRUE, pattern = "sharedStrings.xml$")) | |
| entries <- unlist(entries) | |
| entries <- entries[names(entries) == "si.t"] | |
| names(entries) <- seq_along(entries) - 1 | |
| entries_match <- entries[match(worksheets$v, names(entries))] | |
| worksheets$v[worksheets$t == "s" & !is.na(worksheets$t)] <- | |
| entries_match[worksheets$t == "s"& !is.na(worksheets$t)] | |
| worksheets$cols <- match(gsub("\\d", "", worksheets$r), LETTERS) | |
| worksheets$rows <- as.numeric(gsub("\\D", "", worksheets$r)) | |
| workbook <- lapply(unique(worksheets$sheet), function(x) { | |
| y <- worksheets[worksheets$sheet == x,] | |
| y_style <- as.data.frame(tapply(y$s, list(y$rows, y$cols), identity), | |
| stringsAsFactors = FALSE) | |
| y <- as.data.frame(tapply(y$v, list(y$rows, y$cols), identity), | |
| stringsAsFactors = FALSE) | |
| if(all(!is.na(y[1,]))) { | |
| colnames(y) <- y[1,] | |
| y <- y[-1,] | |
| y_style <- y_style[-1,] | |
| } | |
| y_style <- sapply(y_style, | |
| function(x) ifelse(length(unique(x)) == 1, unique(x), NA)) | |
| y_style <- styles$numFmtId[match(y_style, styles$applyNumberFormat)] | |
| y_style[y_style %in% 14:17] <- "date" | |
| y_style[y_style %in% c(18:21, 45:47)] <- "time" | |
| y_style[y_style %in% 22] <- "datetime" | |
| y_style[is.na(y_style) & !sapply(y, function(x)any(grepl("\\D", x)))] <- "numeric" | |
| y_style[is.na(y_style)] <- "character" | |
| y[] <- lapply(seq_along(y), function(i) { | |
| switch(y_style[i], | |
| character = y[,i], | |
| numeric = as.numeric(y[,i]), | |
| date = as.Date(as.numeric(y[,i]), origin="1899-12-30"), | |
| time = strftime(as.POSIXct(as.numeric(y[,i]), origin="1899-12-30"), format = "%H:%M:%S"), | |
| datetime = as.POSIXct(as.numeric(y[,i]), origin="1899-12-30")) | |
| }) | |
| y | |
| }) | |
| if(length(workbook) == 1) { | |
| workbook <- workbook[[1]] | |
| } | |
| workbook | |
| } |
Sorry, just noticed this comment. I didn't have plans to put this on CRAN any time soon. Not that it wouldn't be useful - I just don't have the time right now.
Hi, thanks for a very efficient method for importing xlsx files.
I've run into a problem I haven't been able to work out. I can't get the function to include more than 26 columns (up to "Z") from a spreadsheet. Have you encountered this problem yourself?
Kind regards,
Erik
You can fix the 26 columns problem by making the following changes:
++++ cc <- sort(unique(gsub("\d", "", worksheets$r)))
++++ cc <- cc[!cc %in% LETTERS]
++++ worksheets$cols <- match(gsub("\d", "", worksheets$r), c(LETTERS, cc))
---- worksheets$cols <- match(gsub("\d", "", worksheets$r), LETTERS)
Thanks for a very useful routine.
Tim Cole
Hi, Thanks for a very useful function. I noticed that in my case the sheetnames got messed up. Second problem is that updates to the excel file are not reflected in the import - realted to the use of a temp dir I guess. Hope you can fix these problems.
Thanks, Oyvind
I have made substantial additions and bug fixes to the xlsxToR R function.
A list of additions and bug fixes are inside the forked function.
An example of usage is:
test <- xlsxToR("TrawlSurveyDataPackage_Canary_ExploreReducedSurvey_2014.xlsx", keep=c(2,4,6,8), skip=c(0,5,5,5))
Where the first argument is the Excel file's path, the second is those sheets you want to read into R, and the third is the number of header lines to skip on top of the file, not counting blank lines.
The result is a R list if more than one sheet is selected or just the table if one sheet is selected.
By default, my addition to simplify names of both sheet and column names is set to TRUE. If some other simplification is wanted, the function can be edited (I put a comment on the lines to edit).
Awesome, thanks so much. This is exactly what I was looking for. I had no idea about XML files but when I saw that each of the data files I am trying to work was in fact made of a folder tree full of XML files I thought they were a lot more complicated than they are... turns out that's just how xslx files are structured, and if they're zipped then they get opened with File Explorer rather than Excel... much confusion.
Anyway it'd make sense for this functionality to be included in the XML package for R... contacted the developer?
May I ask how this function differs from the read.xlsx() function from the gdata package?
Also I misunderstood what the function does... I though the output was an XML data structure, not a R data frame. Still very handy, thanks!
Thanks! It works and avoid me a detour through Python.
I suggest only one change. At line 139 add a make.name call to make the column name valid R names.
if(header) {
#colnames(y) <- y[1,]
colnames(y) <- make.names(y[1,])
I have headers like: "Done?" or "For who?"
Are you going to put that into a package on CRAN?