R:合并行以导出到excel

时间:2019-12-30 19:55:51

标签: r excel openxlsx

如果列中的值相同(在“唯一标识符”组内),则必须合并excel的行。我已经附上了当前openxlsx输出和所需输出的照片。

我知道您可以在SAS中使用PROC REPORT,它会自动执行此操作,因此,我确信有一种方法可以执行此操作。我尝试了flextable,但是我还需要一些条件格式,这是无法做到的。 enter image description here

编辑:

以下数据:

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"))

代码

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)

1 个答案:

答案 0 :(得分:0)

不能完全解决,但是能够创建合并单元格的错觉。

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)