简体   繁体   中英

R: Merging rows to export to excel

I have to merge the rows of excel if the values in a column are identical (within a Unique Identifier group). I've attached a photo of the current openxlsx output and the desired one.

I know in SAS you could use PROC REPORT and it would automatically do this, so I am sure there is a way to do it. I tried flextable but I also need some conditional formatting that it isn't able to do. 在此处输入图片说明

EDIT:

Data below:

structure(list(`Event ID` = c("100717163", "100717163", "100717163", 
"100717163", "100717163", "100717163", "100717163", "100717163", 
"100717163", "100717163", "100717163", "100717163", "100717163", 
"100717163", "100717163", "100717163", "100717216", "100717216", 
"100717216", "100717216", "100717216", "100717216", "100717216", 
"100717216"), WELRSID = c("1215288", "1215288", "1215288", "1215288", 
"1217949", "1217949", "1217949", "1217949", "1217949", "1217949", 
"1217949", "1217949", "1217949", "1217949", "1217949", "1217949", 
"1216411", "1216411", "1216411", "1216411", "1216749", "1216749", 
"1216749", "1216749"), Disease = c("GIA", "GIA", "GIA", "GIA", 
"GIA", "GIA", "GIA", "GIA", "GIA", "GIA", "GIA", "GIA", "GIA", 
"GIA", "GIA", "GIA", "CAM", "CAM", "CAM", "CAM", "CAM", "CAM", 
"CAM", "CAM"), Specimen_type1 = c("STOOL", "STOOL", "STOOL", 
"STOOL", "STOOL", "STOOL", "STOOL", "STOOL", "STOOL", "STOOL", 
"STOOL", "STOOL", "STOOL", "STOOL", "STOOL", "STOOL", "STOOL", 
"STOOL", "STOOL", "STOOL", "STOOL", "STOOL", "STOOL", "STOOL"
), Specimen_type_text = c(NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_), Test_performed = c("ENZYME IMMUNOASSAY (EIA) / ELISA", 
"ENZYME IMMUNOASSAY (EIA) / ELISA", "ENZYME IMMUNOASSAY (EIA) / ELISA", 
"ENZYME IMMUNOASSAY (EIA) / ELISA", "O AND P/MICROSCOPY", "O AND P/MICROSCOPY", 
"O AND P/MICROSCOPY", "O AND P/MICROSCOPY", "O AND P/MICROSCOPY", 
"O AND P/MICROSCOPY", "O AND P/MICROSCOPY", "O AND P/MICROSCOPY", 
"ENZYME IMMUNOASSAY (EIA) / ELISA", "ENZYME IMMUNOASSAY (EIA) / ELISA", 
"ENZYME IMMUNOASSAY (EIA) / ELISA", "ENZYME IMMUNOASSAY (EIA) / ELISA", 
"BACTERIAL CULTURE (ISOLATION)", "BACTERIAL CULTURE (ISOLATION)", 
"BACTERIAL CULTURE (ISOLATION)", "BACTERIAL CULTURE (ISOLATION)", 
"BACTERIAL CULTURE (ISOLATION)", "BACTERIAL CULTURE (ISOLATION)", 
"BACTERIAL CULTURE (ISOLATION)", "BACTERIAL CULTURE (ISOLATION)"
), Test_performed_desc = c("GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", 
"GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", "GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", 
"GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", "OVA / PARASITES IDENTIFIED | RSLT#1", 
"OVA / PARASITES IDENTIFIED | RSLT#1", "OVA / PARASITES IDENTIFIED | RSLT#1", 
"OVA / PARASITES IDENTIFIED | RSLT#1", "OVA / PARASITES IDENTIFIED | RSLT#2", 
"OVA / PARASITES IDENTIFIED | RSLT#2", "OVA / PARASITES IDENTIFIED | RSLT#2", 
"OVA / PARASITES IDENTIFIED | RSLT#2", "GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", 
"GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", "GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", 
"GIARDIA LAMBLIA AG | GIARDIA LAMBLIA AG, EIA", "STOOL-R/O SALM,SHIG,CAMPY |", 
"STOOL-R/O SALM,SHIG,CAMPY |", "STOOL-R/O SALM,SHIG,CAMPY |", 
"STOOL-R/O SALM,SHIG,CAMPY |", "STOOL-R/O SALM,SHIG,CAMPY |", 
"STOOL-R/O SALM,SHIG,CAMPY |", "STOOL-R/O SALM,SHIG,CAMPY |", 
"STOOL-R/O SALM,SHIG,CAMPY |"), WDRS_test_result = c("GIARDIA LAMBLIA ANTIGEN DETECTED", 
"GIARDIA LAMBLIA ANTIGEN DETECTED", "GIARDIA LAMBLIA ANTIGEN DETECTED", 
"GIARDIA LAMBLIA ANTIGEN DETECTED", "GIARDIA LAMBLIA OBSERVED", 
"GIARDIA LAMBLIA OBSERVED", "GIARDIA LAMBLIA OBSERVED", "GIARDIA LAMBLIA OBSERVED", 
"GIARDIA LAMBLIA OBSERVED", "GIARDIA LAMBLIA OBSERVED", "GIARDIA LAMBLIA OBSERVED", 
"GIARDIA LAMBLIA OBSERVED", "GIARDIA LAMBLIA ANTIGEN DETECTED", 
"GIARDIA LAMBLIA ANTIGEN DETECTED", "GIARDIA LAMBLIA ANTIGEN DETECTED", 
"GIARDIA LAMBLIA ANTIGEN DETECTED", "CAMPYLOBACTER SPP.", "CAMPYLOBACTER SPP.", 
"CAMPYLOBACTER SPP.", "CAMPYLOBACTER SPP.", "CAMPYLOBACTER SPP.", 
"CAMPYLOBACTER SPP.", "CAMPYLOBACTER SPP.", "CAMPYLOBACTER SPP."
), WDRS_result_summary = c("POSITIVE", "POSITIVE", "POSITIVE", 
"POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", 
"POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", 
"POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", "POSITIVE", 
"POSITIVE", "POSITIVE", "POSITIVE"), WDRSresult_notcoded = c(NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_, NA_character_, NA_character_, 
NA_character_, NA_character_, NA_character_), Test_result = c("POSITIVE | POSITIVE", 
"POSITIVE | POSITIVE", "POSITIVE | POSITIVE", "POSITIVE | POSITIVE", 
"GIARDIA LAMBLIA CYST | GIARDIA LAMBLIA CYSTS.", "GIARDIA LAMBLIA CYST | GIARDIA LAMBLIA CYSTS.", 
"GIARDIA LAMBLIA CYST | GIARDIA LAMBLIA CYSTS.", "GIARDIA LAMBLIA CYST | GIARDIA LAMBLIA CYSTS.", 
"GIARDIA LAMBLIA TROPHOZOITE | GIARDIA LAMBLIA TROPHOZOITES", 
"GIARDIA LAMBLIA TROPHOZOITE | GIARDIA LAMBLIA TROPHOZOITES", 
"GIARDIA LAMBLIA TROPHOZOITE | GIARDIA LAMBLIA TROPHOZOITES", 
"GIARDIA LAMBLIA TROPHOZOITE | GIARDIA LAMBLIA TROPHOZOITES", 
"POSITIVE | POSITIVE", "POSITIVE | POSITIVE", "POSITIVE | POSITIVE", 
"POSITIVE | POSITIVE", "CAMPYLOBACTER SPECIES |", "CAMPYLOBACTER SPECIES |", 
"CAMPYLOBACTER SPECIES |", "CAMPYLOBACTER SPECIES |", "CAMPYLOBACTER SPECIES |", 
"CAMPYLOBACTER SPECIES |", "CAMPYLOBACTER SPECIES |", "CAMPYLOBACTER SPECIES |"
), `Variable Name` = structure(c(1L, 3L, 4L, 2L, 1L, 3L, 4L, 
2L, 1L, 3L, 4L, 2L, 1L, 3L, 4L, 2L, 1L, 3L, 4L, 2L, 1L, 3L, 4L, 
2L), .Label = c("Result", "Result Summary", "Specimen Type", 
"Test Performed"), class = "factor"), `Change to this (only if Red)` = c("GIARDIA LAMBLIA ANTIGEN DETECTED", 
"STOOL", "ENZYME IMMUNOASSAY (EIA) / ELISA", "POSITIVE", "GIARDIA LAMBLIA OBSERVED", 
"STOOL", "O AND P/MICROSCOPY", "POSITIVE", "GIARDIA LAMBLIA OBSERVED", 
"STOOL", "O AND P/MICROSCOPY", "POSITIVE", "GIARDIA LAMBLIA ANTIGEN DETECTED", 
"STOOL", "ENZYME IMMUNOASSAY (EIA) / ELISA", "POSITIVE", "CAMPYLOBACTER SPP.", 
"STOOL", "BACTERIAL CULTURE (ISOLATION)", "POSITIVE", "CAMPYLOBACTER SPP.", 
"STOOL", "BACTERIAL CULTURE (ISOLATION)", "POSITIVE"), Error = c("No Error", 
"No Error", "No Error", "No Error", "No Error", "No Error", "No Error", 
"No Error", "No Error", "No Error", "No Error", "No Error", "No Error", 
"No Error", "No Error", "No Error", "No Error", "No Error", "No Error", 
"No Error", "No Error", "No Error", "No Error", "No Error"), 
    Error2 = c(0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 0, 
    0, 0, 0, 0, 0, 0, 0, 0)), row.names = c(NA, -24L), class = c("tbl_df", 
"tbl", "data.frame"))

Code :

addWorksheet(wb, "data")

                hs1 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold",
                           border = c("Bottom"), fontColour = "white", borderStyle = "double")
                hs2 <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold",
                                   border = c("Bottom", "Right"), fontColour = "white", borderStyle = "double")

                title <- createStyle(fgFill = "#4F81BD", halign = "CENTER", textDecoration = "Bold", border = "Left", fontColour = "white", borderStyle = "double")

                duplicate <- createStyle(border = "Bottom")
                text <- createStyle(wrapText = TRUE)
                highlighting <- createStyle(fontColour = "red")

        writeData(wb, "data", excel2, startRow = 2, headerStyle = hs1)
        writeData(wb, "data", x = "Key Identifiers", startRow = 1, startCol = 1)
        writeData(wb, "data", x = "Within Lab File", startRow = 1, startCol = 4)
        writeData(wb, "data", x = "Where to Change and What to Replace", startRow = 1, startCol = 12)
        mergeCells(wb, "data", cols = c(1:3), rows = 1)
        mergeCells(wb, "data", cols = c(12:13), rows = 1)
        mergeCells(wb, "data", cols = c(4:11), rows = 1)

        addStyle(wb, "data", rows = 1, cols = 1, gridExpand = TRUE, style = title)
        addStyle(wb, "data", rows = 1, cols = 4, gridExpand = TRUE, style = title)
        addStyle(wb, "data", rows = 1, cols = 12, gridExpand = TRUE, style = title)


        addStyle(wb, "data", rows = 2, cols = 3, gridExpand = TRUE, style = hs2)
        addStyle(wb, "data", rows = 2, cols = 11, gridExpand = TRUE, style = hs2)
        addStyle(wb, "data", rows = 2, cols = 13, gridExpand = TRUE, style = hs2)

        addStyle(wb, "data", text, rows = c(2:nrow(excel)), cols = c(1:15), stack = TRUE, gridExpand =TRUE)
        setColWidths(wb, "data", cols = c(1:15), widths = c(10, 10, 8, 15, 24, 24, 24, 24, 24, 24, 24, 16, "auto", 15, 15))
        setColWidths(wb, "data", cols = c(14:15), hidden = TRUE)
        conditionalFormatting(wb, "data", cols = 13, rows = c(3:nrow(excel)), rule = "O3>=1", style = highlighting)

        conditionalFormatting(wb, "data", cols = 1:13, rows = c(3:nrow(excel)), rule = "$B3 != $B4", style = duplicate)


        conditionalFormatting(wb, "data", cols = 2, rows = c(3:nrow(excel)), rule = "$B3 != $B4", color = "blue", showValue = FALSE, 
                              )
        saveWorkbook(wb, "Data Dashboard.xlsx", overwrite = TRUE)

Not a total fix, but was able to create ILLUSION of merged cells.

empty <- createStyle(fontColour = "white")
conditionalFormatting(wb, "data", cols = 2, rows = c(4:nrow(excel)), rule = "$B4 = $B3", style = empty)
conditionalFormatting(wb, "data", cols = 3, rows = c(4:nrow(excel)), rule = "$C4 = $C3", style = empty)
conditionalFormatting(wb, "data", cols = 4, rows = c(4:nrow(excel)), rule = "AND($D4=$D3,$B4 = $B3)", style = empty)
conditionalFormatting(wb, "data", cols = 5, rows = c(4:nrow(excel)), rule = "AND($E4=$E3,$B4 = $B3)", style = empty)

The technical post webpages of this site follow the CC BY-SA 4.0 protocol. If you need to reprint, please indicate the site URL or the original address.Any question please contact:yoyou2525@163.com.

 
粤ICP备18138465号  © 2020-2024 STACKOOM.COM